home *** CD-ROM | disk | FTP | other *** search
/ The CICA Windows Explosion! / The CICA Windows Explosion! - Disc 1.iso / desktop / mnyth2.zip / MANYTHNG.FRM < prev    next >
Text File  |  1994-02-18  |  84KB  |  3,331 lines

  1. VERSION 2.00
  2. Begin Form ManyThings 
  3.    BackColor       =   &H00000000&
  4.    BorderStyle     =   0  'None
  5.    ClientHeight    =   4605
  6.    ClientLeft      =   900
  7.    ClientTop       =   1605
  8.    ClientWidth     =   5805
  9.    ControlBox      =   0   'False
  10.    Height          =   5010
  11.    Icon            =   MANYTHNG.FRX:0000
  12.    Left            =   840
  13.    LinkTopic       =   "Form1"
  14.    ScaleHeight     =   307
  15.    ScaleMode       =   3  'Pixel
  16.    ScaleWidth      =   387
  17.    Top             =   1260
  18.    Width           =   5925
  19.    Begin Timer Tick 
  20.       Enabled         =   0   'False
  21.       Interval        =   50
  22.       Left            =   10
  23.       Top             =   10
  24.    End
  25. End
  26. ' BackGround -- this form expands to fill the whole
  27. '   screen and is used as the back drop for all the
  28. '   drawing
  29.  
  30. Option Explicit
  31.  
  32. ' variables declared here
  33. Dim MouseX, MouseY ' Last position of the mouse moves
  34. Dim LastX As Integer, LastY As Integer
  35. Dim conv2x As Single, conv2y As Single
  36. Dim LastTime As Long
  37. Dim CurrentTime As Long
  38. Dim LinkTime As Long
  39. Dim PlotType As Integer
  40. Dim PlotInit As Integer
  41. Dim PlotEnd As Integer
  42. Dim RepeatIndex As Integer
  43. Dim Pointer As Integer
  44. Dim Mirror As Integer
  45. Dim RunMode As Integer
  46. Dim x1 As Integer, y1 As Integer, x2 As Integer, y2 As Integer
  47. Dim vx1 As Single, vy1 As Single, vx2 As Single, vy2 As Single
  48. Dim ax1 As Single, ax2 As Single, ay1 As Single, ay2 As Single
  49. Dim l As Long
  50. Dim m As Long
  51. Dim MaxSpeedX As Integer, MaxSpeedY As Integer
  52. Dim TimeInterval As Long
  53. Dim MaxTime As Long
  54. Dim Repeats As Integer
  55. Dim i As Integer
  56. Dim BoxHeight As Integer, Boxwidth As Integer
  57. Dim DC As Integer
  58. Dim Pattern As Long, Locked As Integer
  59. Dim Direction As Integer
  60. Dim Number As Integer
  61. Dim PicWidth As Integer, PicHeight As Integer
  62. Dim PlotPriority As Integer
  63. Dim Priority As Single
  64. Dim TotalPriority As Single
  65. Dim PriorityBreakPoints() As Single
  66. Const MinColor = 20000
  67.     
  68. 'Allocate Memory
  69. Dim x1a() As Integer
  70. Dim x2a() As Integer
  71. Dim y1a() As Integer
  72. Dim y2a() As Integer
  73. Dim x1da() As Integer
  74. Dim x2da() As Integer
  75. Dim y1da() As Integer
  76. Dim y2da() As Integer
  77. Dim x1sa() As Single
  78. Dim x2sa() As Single
  79. Dim y1sa() As Single
  80. Dim y2sa() As Single
  81. Dim vx1sa() As Single
  82. Dim vx2sa() As Single
  83. Dim vy1sa() As Single
  84. Dim vy2sa() As Single
  85. Dim ax1sa() As Single
  86. Dim ax2sa() As Single
  87. Dim ay1sa() As Single
  88. Dim ay2sa() As Single
  89. Dim Colors() As Long
  90. Dim DataPts() As Integer
  91.  
  92. 'for filled polygons
  93. Dim Points() As POINTAPI
  94.  
  95. Dim MaxPlotType As Integer
  96.  
  97. Function CheckIfValidMode (SaverMode As Integer) As Integer
  98.   'when in low memory mode the saver only runs the modules
  99.   'that draw on the screen, not those that manipulate
  100.   'bitmaps
  101.   If LowMemoryFlag = 0 Then 'if not low memory mode then done
  102.     CheckIfValidMode = 1
  103.   Else
  104.     If SaverMode <> 0 Then
  105.       NextSelection
  106.       CheckIfValidMode = 0
  107.       LogFile ("Saver not valid in low memory: " + Str$(PlotType))
  108.     Else
  109.       CheckIfValidMode = 1
  110.     End If
  111.  
  112.   End If
  113.  
  114. End Function
  115.  
  116. Sub Circles ()
  117.   
  118.   ' have a single elipse trace across the
  119.   ' screen with multiple previous copies following
  120.   ' it
  121.  
  122.   Dim i As Integer, j As Integer, k As Integer, n As Integer
  123.   Dim il As Long, jl As Long, kl As Long
  124.   Dim xRadius As Integer, yRadius As Integer
  125.   Dim HighMirror As Integer
  126.  
  127.   ' if first time then initialize
  128.   If PlotInit = False Then
  129.  
  130.     'see if we need to reset changes made from previous init
  131.     If PlotEnd = False Then
  132.  
  133.       'see if we just want the priority for this saver
  134.       If PlotPriority = True Then
  135.     '1 is normal priority, adjust up to show more often, or down ...
  136.     Priority = 1#
  137.     Exit Sub
  138.       End If
  139.  
  140.     'check if runing low memory mode
  141.     If CheckIfValidMode(0) = 0 Then
  142.       Exit Sub
  143.     End If
  144.     
  145.     PlotInit = True
  146.     Cls
  147.     ForeColor = QBColor(15)
  148.  
  149.     'Set array size and clear the elements
  150.     ReDim x1a(MaxLines) As Integer
  151.     ReDim x2a(MaxLines) As Integer
  152.     ReDim y1a(MaxLines) As Integer
  153.     ReDim y2a(MaxLines) As Integer
  154.  
  155.     Pointer = 1     ' start with array element 1
  156.     
  157.     ' set index to count number of times to repeat color
  158.     '   to past maxvalue so that it will be recalculated
  159.     RepeatIndex = MaxLines + 1
  160.  
  161.     'determine initial position of line
  162.     x1 = Rnd * ScaleWidth
  163.     x2 = Rnd * ScaleWidth
  164.     y1 = Rnd * ScaleHeight
  165.     y2 = Rnd * ScaleHeight
  166.  
  167.     'set initial velocity
  168.     vx1 = 0
  169.     vx2 = 0
  170.     vy1 = 0
  171.     vy2 = 0
  172.  
  173.     'set initial acceleration
  174.     ax1 = 0
  175.     ax2 = 0
  176.     ay1 = 0
  177.     ay2 = 0
  178.     
  179.     'find background color
  180.     m = QBColor(0)
  181.  
  182.     'Calculate velocity limits
  183.     MaxSpeedX = ScaleWidth * 15! / 800
  184.     MaxSpeedY = ScaleWidth * 15! / 600
  185.  
  186.     'select mirroring method
  187.     HighMirror = 5
  188.     Mirror = Rnd * HighMirror + 1: If Mirror > HighMirror Then Mirror = 1
  189.  
  190.   Else 'reset changes done by previous init
  191.  
  192.     'zero array sizes
  193.     ReDim x1a(0) As Integer
  194.     ReDim x2a(0) As Integer
  195.     ReDim y1a(0) As Integer
  196.     ReDim y2a(0) As Integer
  197.  
  198.   End If
  199.  
  200.   Else  ' put run code here
  201.  
  202.     Tick.Enabled = False' disable timer until circles completed
  203.  
  204.     ' check if time to get a new color
  205.     If RepeatIndex > RepeatCount Then
  206.     
  207.     ' use rgb function
  208.     Do
  209.       il = Rnd * 255: If il > 255 Then il = 255
  210.       jl = Rnd * 255: If jl > 255 Then jl = 255
  211.       kl = Rnd * 255: If kl > 255 Then kl = 255
  212.     Loop Until (il * il + jl * jl + kl * kl) > MinColor'make sure color if sufficiently bright
  213.     l = RGB(il, jl, kl)
  214.  
  215.     RepeatIndex = 1
  216.     Else
  217.     RepeatIndex = RepeatIndex + 1
  218.     End If
  219.  
  220.     'Delete original circle
  221.     xRadius = Abs(x1a(Pointer) - x2a(Pointer)) / 2
  222.     yRadius = Abs(y1a(Pointer) - y2a(Pointer)) / 2
  223.     If xRadius <> 0 Then
  224.         Circle ((x1a(Pointer) + x2a(Pointer)) / 2, (y1a(Pointer) + y2a(Pointer)) / 2), xRadius, m, , , yRadius / xRadius
  225.     End If
  226.  
  227.     DoEvents
  228.  
  229.     Select Case Mirror
  230.     Case 1: 'mirror on x and y axis
  231.         
  232.         'Delete original circle mirrored on Y axis
  233.         xRadius = Abs(x1a(Pointer) - x2a(Pointer)) / 2
  234.         yRadius = Abs(y1a(Pointer) - y2a(Pointer)) / 2
  235.         If xRadius <> 0 Then
  236.         Circle ((ScaleWidth - x1a(Pointer) + ScaleWidth - x2a(Pointer)) / 2, (y1a(Pointer) + y2a(Pointer)) / 2), xRadius, m, , , yRadius / xRadius
  237.         End If
  238.  
  239.         DoEvents
  240.  
  241.         'Delete original circle mirrored on X axis
  242.         xRadius = Abs(x1a(Pointer) - x2a(Pointer)) / 2
  243.         yRadius = Abs(y1a(Pointer) - y2a(Pointer)) / 2
  244.         If xRadius <> 0 Then
  245.         Circle ((x1a(Pointer) + x2a(Pointer)) / 2, (ScaleHeight - y1a(Pointer) + ScaleHeight - y2a(Pointer)) / 2), xRadius, m, , , yRadius / xRadius
  246.         End If
  247.  
  248.         DoEvents
  249.  
  250.         'Delete original circle mirrored on origin
  251.         xRadius = Abs(x1a(Pointer) - x2a(Pointer)) / 2
  252.         yRadius = Abs(y1a(Pointer) - y2a(Pointer)) / 2
  253.         If xRadius <> 0 Then
  254.         Circle ((ScaleWidth - x1a(Pointer) + ScaleWidth - x2a(Pointer)) / 2, (ScaleHeight - y1a(Pointer) + ScaleHeight - y2a(Pointer)) / 2), xRadius, m, , , yRadius / xRadius
  255.         End If
  256.  
  257.         DoEvents
  258.  
  259.     Case 2: 'mirror on Y axis
  260.         
  261.         'Delete original circle mirrored on Y axis
  262.         xRadius = Abs(x1a(Pointer) - x2a(Pointer)) / 2
  263.         yRadius = Abs(y1a(Pointer) - y2a(Pointer)) / 2
  264.         If xRadius <> 0 Then
  265.         Circle ((ScaleWidth - x1a(Pointer) + ScaleWidth - x2a(Pointer)) / 2, (y1a(Pointer) + y2a(Pointer)) / 2), xRadius, m, , , yRadius / xRadius
  266.         End If
  267.  
  268.         DoEvents
  269.  
  270.     Case 3: 'mirror around center point
  271.     
  272.         'Delete original circle mirrored on origin
  273.         xRadius = Abs(x1a(Pointer) - x2a(Pointer)) / 2
  274.         yRadius = Abs(y1a(Pointer) - y2a(Pointer)) / 2
  275.         If xRadius <> 0 Then
  276.         Circle ((ScaleWidth - x1a(Pointer) + ScaleWidth - x2a(Pointer)) / 2, (ScaleHeight - y1a(Pointer) + ScaleHeight - y2a(Pointer)) / 2), xRadius, m, , , yRadius / xRadius
  277.         End If
  278.  
  279.         DoEvents
  280.  
  281.     Case Else: ' otherwise ignore (i.e. no mirror)
  282.     
  283.     End Select
  284.  
  285.     'Save New Circle
  286.     x1a(Pointer) = x1
  287.     x2a(Pointer) = x2
  288.     y1a(Pointer) = y1
  289.     y2a(Pointer) = y2
  290.  
  291.     Select Case Mirror
  292.     Case 1: 'mirror on x and y axis
  293.         
  294.         'Delete original circle mirrored on Y axis
  295.         xRadius = Abs(x1a(Pointer) - x2a(Pointer)) / 2
  296.         yRadius = Abs(y1a(Pointer) - y2a(Pointer)) / 2
  297.         If xRadius <> 0 Then
  298.         Circle ((ScaleWidth - x1a(Pointer) + ScaleWidth - x2a(Pointer)) / 2, (y1a(Pointer) + y2a(Pointer)) / 2), xRadius, l, , , yRadius / xRadius
  299.         End If
  300.  
  301.         DoEvents
  302.  
  303.         'Delete original circle mirrored on X axis
  304.         xRadius = Abs(x1a(Pointer) - x2a(Pointer)) / 2
  305.         yRadius = Abs(y1a(Pointer) - y2a(Pointer)) / 2
  306.         If xRadius <> 0 Then
  307.         Circle ((x1a(Pointer) + x2a(Pointer)) / 2, (ScaleHeight - y1a(Pointer) + ScaleHeight - y2a(Pointer)) / 2), xRadius, l, , , yRadius / xRadius
  308.         End If
  309.  
  310.         DoEvents
  311.  
  312.         'Delete original circle mirrored on origin
  313.         xRadius = Abs(x1a(Pointer) - x2a(Pointer)) / 2
  314.         yRadius = Abs(y1a(Pointer) - y2a(Pointer)) / 2
  315.         If xRadius <> 0 Then
  316.         Circle ((ScaleWidth - x1a(Pointer) + ScaleWidth - x2a(Pointer)) / 2, (ScaleHeight - y1a(Pointer) + ScaleHeight - y2a(Pointer)) / 2), xRadius, l, , , yRadius / xRadius
  317.         End If
  318.  
  319.     Case 2: 'mirror on Y axis
  320.         
  321.         'Delete original circle mirrored on y axis
  322.         xRadius = Abs(x1a(Pointer) - x2a(Pointer)) / 2
  323.         yRadius = Abs(y1a(Pointer) - y2a(Pointer)) / 2
  324.         If xRadius <> 0 Then
  325.         Circle ((ScaleWidth - x1a(Pointer) + ScaleWidth - x2a(Pointer)) / 2, (y1a(Pointer) + y2a(Pointer)) / 2), xRadius, l, , , yRadius / xRadius
  326.         End If
  327.  
  328.     Case 3: 'mirror around center point
  329.     
  330.         'Delete original circle mirrored on origin
  331.         xRadius = Abs(x1a(Pointer) - x2a(Pointer)) / 2
  332.         yRadius = Abs(y1a(Pointer) - y2a(Pointer)) / 2
  333.         If xRadius <> 0 Then
  334.         Circle ((ScaleWidth - x1a(Pointer) + ScaleWidth - x2a(Pointer)) / 2, (ScaleHeight - y1a(Pointer) + ScaleHeight - y2a(Pointer)) / 2), xRadius, l, , , yRadius / xRadius
  335.         End If
  336.  
  337.     Case Else: ' otherwise ignore (i.e. no mirror)
  338.     
  339.     End Select
  340.  
  341.     DoEvents
  342.  
  343.     Tick.Enabled = True' re-enable timer
  344.  
  345.     'Draw new Circle
  346.     xRadius = Abs(x1a(Pointer) - x2a(Pointer)) / 2
  347.     yRadius = Abs(y1a(Pointer) - y2a(Pointer)) / 2
  348.     If xRadius <> 0 Then
  349.         Circle ((x1a(Pointer) + x2a(Pointer)) / 2, (y1a(Pointer) + y2a(Pointer)) / 2), xRadius, l, , , yRadius / xRadius
  350.     End If
  351.  
  352.     'Move pointer to next item
  353.     Pointer = Pointer + 1
  354.     If Pointer > MaxLines Then
  355.         Pointer = 1
  356.     End If
  357.  
  358.     'determine new acceleration
  359.     ax1 = Rnd - .5
  360.     ax2 = Rnd - .5
  361.     ay1 = Rnd - .5
  362.     ay2 = Rnd - .5
  363.  
  364.     'calculate new position
  365.     x1 = x1 + vx1
  366.     x2 = x2 + vx2
  367.     y1 = y1 + vy1
  368.     y2 = y2 + vy2
  369.  
  370.     'calculate new velocity
  371.     vx1 = (vx1 + ax1): If Abs(vx1) > MaxSpeedX Then vx1 = 0: ax1 = 0
  372.     vx2 = (vx2 + ax2): If Abs(vx2) > MaxSpeedX Then vx2 = 0: ax2 = 0
  373.     vy1 = (vy1 + ay1): If Abs(vy1) > MaxSpeedY Then vy1 = 0: ay1 = 0
  374.     vy2 = (vy2 + ay2): If Abs(vy2) > MaxSpeedY Then vy2 = 0: ay2 = 0
  375.  
  376.     'check if off screen
  377.     If (x1 > ScaleWidth) Then
  378.         'change direction
  379.         vx1 = -Abs(vx1)
  380.     ElseIf (x1 < 0) Then
  381.         'change direction
  382.         vx1 = Abs(vx1)
  383.     End If
  384.  
  385.     If (y1 > ScaleHeight) Then
  386.         'change direction
  387.         vy1 = -Abs(vy1)
  388.     ElseIf (y1 < 0) Then
  389.         'change direction
  390.         vy1 = Abs(vy1)
  391.     End If
  392.  
  393.     If (x2 > ScaleWidth) Then
  394.         'change direction
  395.         vx2 = -Abs(vx2)
  396.     ElseIf (x2 < 0) Then
  397.         'change direction
  398.         vx2 = Abs(vx2)
  399.     End If
  400.  
  401.     If (y2 > ScaleHeight) Then
  402.         'change direction
  403.         vy2 = -Abs(vy2)
  404.     ElseIf (y2 < 0) Then
  405.         'change direction
  406.         vy2 = Abs(vy2)
  407.     End If
  408.  
  409.  
  410.   End If
  411.  
  412. End Sub
  413.  
  414. Sub Dribble ()
  415.  
  416.   'dribbling paint on screen
  417.  
  418.   Dim i As Integer, j As Integer, k As Integer
  419.   Static MaxHole As Integer
  420.  
  421.   ' if first time then initialize
  422.   If PlotInit = False Then
  423.     
  424.     'see if we need to reset changes made from previous init
  425.     If PlotEnd = False Then
  426.     
  427.       'see if we just want the priority for this saver
  428.       If PlotPriority = True Then
  429.     '1 is normal priority, adjust up to show more often, or down ...
  430.     Priority = 1#
  431.     Exit Sub
  432.       End If
  433.     
  434.     'check if runing low memory mode
  435.     If CheckIfValidMode(1) = 0 Then
  436.       Exit Sub
  437.     End If
  438.     
  439.     ' start with original screen
  440.     Picture = Original.Image
  441.     
  442.     PlotInit = True
  443.  
  444.     'determine initial position of shot
  445.     x1 = Rnd * ScaleWidth
  446.     y1 = Rnd * ScaleHeight
  447.     
  448.     'Calculate velocity limits
  449.     MaxSpeedX = ScaleWidth * 20! / 800
  450.     MaxSpeedY = ScaleWidth * 20! / 600
  451.  
  452.     ' zero initial velocity
  453.     vx1 = 0: vy1 = 0
  454.  
  455.     'set maximum size of holes
  456.     MaxHole = 4
  457.  
  458.     ForeColor = RGB(0, 0, 0)' use black box
  459.     FillColor = RGB(0, 0, 0) 'set black fill
  460.     FillStyle = 0 'solid fill
  461.  
  462.     RunMode = Int(Rnd * 2#)'choose black or color
  463.  
  464.     'Debug.Print RunMode
  465.  
  466.     If RunMode > 0 Then ' if random color then use larger spots
  467.     MaxHole = 8
  468.     i = Rnd * 255: If i > 255 Then i = 255
  469.     j = Rnd * 255: If j > 255 Then j = 255
  470.     k = Rnd * 255: If k > 255 Then k = 255
  471.     ForeColor = GetNearestColor(hDC, RGB(i, j, k))
  472.     FillColor = ForeColor
  473.     End If
  474.  
  475.   Else 'reset changes done by previous init
  476.  
  477.     Picture = LoadPicture() ' clear screen
  478.     FillStyle = 1 'transparent fill
  479.  
  480.   End If
  481.  
  482.   Else  ' put run code here
  483.  
  484.     If RunMode > 0 Then ' see if need to change to random color
  485.  
  486.         If Rnd < .05 Then
  487.         i = Rnd * 255: If i > 255 Then i = 255
  488.         j = Rnd * 255: If j > 255 Then j = 255
  489.         k = Rnd * 255: If k > 255 Then k = 255
  490.         ForeColor = GetNearestColor(hDC, RGB(i, j, k))
  491.         FillColor = ForeColor
  492.         End If
  493.  
  494.     End If
  495.     
  496.     ' put random hole here
  497.     Circle (x1 + Rnd * 20, y1 + Rnd * 20), MaxHole * Rnd + 2, , , , 1
  498.  
  499.     'determine new acceleration
  500.     ax1 = 2 * Rnd - 1
  501.     ay1 = 2 * Rnd - 1
  502.         
  503.     'calculate new position
  504.     x1 = x1 + vx1
  505.     y1 = y1 + vy1
  506.         
  507.     'calculate new velocity
  508.     vx1 = (vx1 + ax1): If Abs(vx1) > MaxSpeedX Then vx1 = -vx1 * .9: vy1 = -vy1 * .9: ax1 = 0
  509.     vy1 = (vy1 + ay1): If Abs(vy1) > MaxSpeedY Then vx1 = -vx1 * .9: vy1 = -vy1 * .9: ay1 = 0
  510.         
  511.     'check if off screen
  512.     If (x1 > ScaleWidth) Then
  513.         'change direction
  514.         vx1 = -Abs(vx1)
  515.     ElseIf (x1 < 0) Then
  516.         'change direction
  517.         vx1 = Abs(vx1)
  518.     End If
  519.  
  520.     If (y1 > ScaleHeight) Then
  521.         'change direction
  522.         vy1 = -Abs(vy1)
  523.     ElseIf (y1 < 0) Then
  524.         'change direction
  525.         vy1 = Abs(vy1)
  526.     End If
  527.  
  528.   End If
  529.  
  530. End Sub
  531.  
  532. Sub Drop ()
  533.  
  534.   ' bitblt's with various patterns, dragging them
  535.   ' across the screen randomly
  536.  
  537.   Dim j As Integer
  538.   Static OldY As Integer
  539.  
  540.   ' if first time then initialize
  541.   If PlotInit = False Then
  542.  
  543.     'see if we need to reset changes made from previous init
  544.     If PlotEnd = False Then
  545.     
  546.       'see if we just want the priority for this saver
  547.       If PlotPriority = True Then
  548.     '1 is normal priority, adjust up to show more often, or down ...
  549.     Priority = 1#
  550.     Exit Sub
  551.       End If
  552.     
  553.     'check if runing low memory mode
  554.     If CheckIfValidMode(1) = 0 Then
  555.       Exit Sub
  556.     End If
  557.     
  558.     'store whether column has dropped
  559.     ReDim x1a(ScaleWidth)
  560.  
  561.     ' start with original screen
  562.     Picture = Original.Image
  563.  
  564.     PlotInit = True
  565.  
  566.     'flag that no column has been chosen
  567.     x1 = -1
  568.  
  569.     'Calculate velocity limits
  570.     MaxSpeedY = ScaleWidth * 10! / 600
  571.     MaxSpeedX = ScaleWidth * 10! / 800
  572.  
  573.     ' zero initial velocity
  574.     vy1 = 0
  575.  
  576.     'width of column to drop
  577.     Boxwidth = 10 + Rnd * 100
  578.  
  579.     i = Int(Rnd * 2#)'if i=0 then do jagged drop
  580.  
  581.     x2 = 0 'used for width change
  582.  
  583.   Else 'reset changes done by previous init
  584.  
  585.     'store whether column has dropped
  586.     ReDim x1a(0)
  587.     Picture = LoadPicture() ' clear screen
  588.  
  589.   End If
  590.  
  591. Else  ' put run code here
  592.  
  593.     If x1 < 0 Then 'see if found valid column
  594.  
  595.     x1 = Rnd * ScaleWidth / Boxwidth 'choose a column
  596.     
  597.     If x1a(x1) = 0 Then 'check if not yet dropped
  598.     y1 = 0 'start position
  599.     x1a(x1) = 1 'flag that column has already been used
  600.     x2 = 0: vx2 = 0: OldY = 0' initialize variables
  601.  
  602.     Else
  603.     x1 = -1 'flag that no column chosen
  604.     End If
  605.  
  606.     Else 'if column already found, then drop it
  607.  
  608.     If i = 0 Then 'check if jagged drop
  609.  
  610.     'make sure effective width does not get too small
  611.     If x2 >= Boxwidth - 5 Then
  612.     x2 = Boxwidth - 5
  613.     vx2 = -vx2 'reverse direction
  614.     End If
  615.  
  616.     j = x2 / 2 'get half of change
  617.  
  618.     'shift column
  619.     DC = Original.hDC
  620.     BitBlt hDC, x1 * Boxwidth + j, y1, Boxwidth - x2, ScaleHeight - y1, DC, x1 * Boxwidth + j, 0, &HCC0020'source copy
  621.     
  622.     'blank top of column
  623.     BitBlt hDC, x1 * Boxwidth + j, OldY, Boxwidth - x2, y1 - OldY + 1, DC, x1 * Boxwidth + j, 0, &H42'blackout
  624.     
  625.     Else ' not jagged drop
  626.  
  627.     'shift column
  628.     DC = Original.hDC
  629.     BitBlt hDC, x1 * Boxwidth, y1, Boxwidth, ScaleHeight - y1, DC, x1 * Boxwidth, 0, &HCC0020  'source copy
  630.     
  631.     'blank top of column
  632.     BitBlt hDC, x1 * Boxwidth, OldY, Boxwidth, y1 - OldY + 1, DC, x1 * Boxwidth, 0, &H42'blackout
  633.     
  634.     End If
  635.  
  636.     'save current position
  637.     OldY = y1
  638.  
  639.     'check if off screen
  640.     If (y1 > ScaleHeight) Then
  641.     x1 = -1 'flag done
  642.     vy1 = 0'zero velocity again
  643.     End If
  644.  
  645.     'determine new acceleration
  646.     ay1 = Rnd * .25
  647.     ax2 = Rnd * .25 - .125
  648.     
  649.     'calculate new positions
  650.     y1 = y1 + vy1
  651.     x2 = x2 + vx2
  652.     
  653.     'calculate new velocity
  654.     vy1 = (vy1 + ay1): If Abs(vy1) > MaxSpeedY Then vy1 = vy1 / 2: ay1 = 0
  655.     vx2 = (vx2 + ax2): If Abs(vx2) > MaxSpeedX Then vx2 = vx2 / 2: ax2 = 0
  656.     
  657.     End If
  658.  
  659.   End If
  660.  
  661. End Sub
  662.  
  663. Sub FilledCircles ()
  664.   
  665.   ' have a single filled elipse trace across the screen
  666.  
  667.   Dim i As Integer, j As Integer, k As Integer, n As Integer
  668.   Dim xRadius As Integer, yRadius As Integer
  669.  
  670.   ' if first time then initialize
  671.   If PlotInit = False Then
  672.  
  673.     'see if we need to reset changes made from previous init
  674.     If PlotEnd = False Then
  675.  
  676.       'see if we just want the priority for this saver
  677.       If PlotPriority = True Then
  678.     '1 is normal priority, adjust up to show more often, or down ...
  679.     Priority = 1#
  680.     Exit Sub
  681.       End If
  682.     
  683.     'check if runing low memory mode
  684.     If CheckIfValidMode(0) = 0 Then
  685.       Exit Sub
  686.     End If
  687.     
  688.     PlotInit = True
  689.     Cls
  690.     ForeColor = QBColor(15)
  691.     FillColor = ForeColor
  692.     BackColor = QBColor(0)
  693.     FillStyle = 0' use solid fill
  694.  
  695.     ' set index to count number of times to repeat color
  696.     '   to past maxvalue so that it will be recalculated
  697.     RepeatIndex = MaxLines + 1
  698.  
  699.     'determine initial position of line
  700.     x1 = Rnd * ScaleWidth
  701.     x2 = Rnd * ScaleWidth
  702.     y1 = Rnd * ScaleHeight
  703.     y2 = Rnd * ScaleHeight
  704.  
  705.     'set initial velocity
  706.     vx1 = 0
  707.     vx2 = 0
  708.     vy1 = 0
  709.     vy2 = 0
  710.  
  711.     'set initial acceleration
  712.     ax1 = 0
  713.     ax2 = 0
  714.     ay1 = 0
  715.     ay2 = 0
  716.     
  717.     'find background color
  718.     'Calculate velocity limits
  719.     MaxSpeedX = ScaleWidth * 15! / 800
  720.     MaxSpeedY = ScaleWidth * 15! / 600
  721.  
  722.   Else 'reset changes done by previous init
  723.  
  724.     FillStyle = 1 'transparent fill
  725.  
  726.   End If
  727.  
  728.   Else  ' put run code here
  729.  
  730.     ' check if time to get a new color
  731.     If RepeatIndex > RepeatCount Then
  732.     
  733.     ' get random fore ground color
  734.     i = Rnd * 255: If i > 255 Then i = 255
  735.     j = Rnd * 255: If j > 255 Then j = 255
  736.     k = Rnd * 255: If k > 255 Then k = 255
  737.     ForeColor = RGB(i, j, k)
  738.  
  739.     ' get random fill color
  740.     i = Rnd * 255: If i > 255 Then i = 255
  741.     j = Rnd * 255: If j > 255 Then j = 255
  742.     k = Rnd * 255: If k > 255 Then k = 255
  743.     FillColor = GetNearestColor(hDC, RGB(i, j, k))
  744.  
  745.     RepeatIndex = 1
  746.     Else
  747.     RepeatIndex = RepeatIndex + 1
  748.     End If
  749.  
  750.     'Draw new Circle
  751.     xRadius = Abs(x1 - x2) / 2
  752.     yRadius = Abs(y1 - y2) / 2
  753.     If xRadius <> 0 Then
  754.         Circle ((x1 + x2) / 2, (y1 + y2) / 2), xRadius, , , , yRadius / xRadius
  755.     End If
  756.  
  757.     'Move pointer to next item
  758.     Pointer = Pointer + 1
  759.     If Pointer > MaxLines Then
  760.         Pointer = 1
  761.     End If
  762.  
  763.     'determine new acceleration
  764.     ax1 = Rnd - .5
  765.     ax2 = Rnd - .5
  766.     ay1 = Rnd - .5
  767.     ay2 = Rnd - .5
  768.  
  769.     'calculate new position
  770.     x1 = x1 + vx1
  771.     x2 = x2 + vx2
  772.     y1 = y1 + vy1
  773.     y2 = y2 + vy2
  774.  
  775.     'calculate new velocity
  776.     vx1 = (vx1 + ax1): If Abs(vx1) > MaxSpeedX Then vx1 = 0: ax1 = 0
  777.     vx2 = (vx2 + ax2): If Abs(vx2) > MaxSpeedX Then vx2 = 0: ax2 = 0
  778.     vy1 = (vy1 + ay1): If Abs(vy1) > MaxSpeedY Then vy1 = 0: ay1 = 0
  779.     vy2 = (vy2 + ay2): If Abs(vy2) > MaxSpeedY Then vy2 = 0: ay2 = 0
  780.  
  781.     'check if off screen
  782.     If (x1 > ScaleWidth) Then
  783.         'change direction
  784.         vx1 = -Abs(vx1)
  785.     ElseIf (x1 < 0) Then
  786.         'change direction
  787.         vx1 = Abs(vx1)
  788.     End If
  789.  
  790.     If (y1 > ScaleHeight) Then
  791.         'change direction
  792.         vy1 = -Abs(vy1)
  793.     ElseIf (y1 < 0) Then
  794.         'change direction
  795.         vy1 = Abs(vy1)
  796.     End If
  797.  
  798.     If (x2 > ScaleWidth) Then
  799.         'change direction
  800.         vx2 = -Abs(vx2)
  801.     ElseIf (x2 < 0) Then
  802.         'change direction
  803.         vx2 = Abs(vx2)
  804.     End If
  805.  
  806.     If (y2 > ScaleHeight) Then
  807.         'change direction
  808.         vy2 = -Abs(vy2)
  809.     ElseIf (y2 < 0) Then
  810.         'change direction
  811.         vy2 = Abs(vy2)
  812.     End If
  813.  
  814.  
  815.   End If
  816.  
  817.  
  818. End Sub
  819.  
  820. Sub FilledPolygons ()
  821.  
  822.   ' draw a randomly moving polygon on the screen
  823.   ' slightly offset from previous polygon
  824.  
  825.   Dim i As Integer, j As Integer, k As Integer, ii As Integer, n As Integer
  826.   Static Sets As Integer
  827.   
  828.   ' if first time then initialize
  829.   If PlotInit = False Then
  830.     
  831.     'see if we need to reset changes made from previous init
  832.     If PlotEnd = False Then
  833.     
  834.       'see if we just want the priority for this saver
  835.       If PlotPriority = True Then
  836.     '1 is normal priority, adjust up to show more often, or down ...
  837.     Priority = 1#
  838.     Exit Sub
  839.       End If
  840.     
  841.     'check if runing low memory mode
  842.     If CheckIfValidMode(0) = 0 Then
  843.       Exit Sub
  844.     End If
  845.     
  846.     PlotInit = True
  847.     ForeColor = RGB(255, 255, 255)
  848.     BackColor = RGB(0, 0, 0)
  849.     FillStyle = 0' use solid fill
  850.     DrawWidth = 1' use narrow line
  851.     j = SetPolyFillMode(hDC, 2)' use winding fill mode
  852.     Cls
  853.  
  854.     'set number of corners between 3 and 5
  855.     Sets = Rnd * 4 + 3
  856.  
  857.     'Set array size and clear the elements
  858.     ReDim Points(Sets) As POINTAPI
  859.     ReDim vx1sa(Sets) As Single
  860.     ReDim vy1sa(Sets) As Single
  861.     ReDim ax1sa(Sets) As Single
  862.     ReDim ay1sa(Sets) As Single
  863.     
  864.     'counter for changing colors, set to overflow
  865.     RepeatIndex = RepeatCount + 1
  866.     
  867.     For j = 1 To Sets
  868.  
  869.     'determine initial position of line
  870.     Points(j).x = Rnd * ScaleWidth
  871.     Points(j).y = Rnd * ScaleHeight
  872.  
  873.     Next j
  874.     
  875.     'Calculate velocity limits
  876.     MaxSpeedX = ScaleWidth * 15! / 800
  877.     MaxSpeedY = ScaleWidth * 15! / 600
  878.  
  879.   Else 'reset changes done by previous init
  880.  
  881.     ReDim Points(0) As POINTAPI
  882.     ReDim vx1sa(0) As Single
  883.     ReDim vy1sa(0) As Single
  884.     ReDim ax1sa(0) As Single
  885.     ReDim ay1sa(0) As Single
  886.  
  887.     FillStyle = 1 'transparent fill
  888.     j = SetPolyFillMode(hDC, 1)' reset to alternate fill mode
  889.     
  890.   End If
  891.  
  892.   Else  ' put run code here
  893.  
  894.  
  895.     ' check if time to get a new color
  896.     If RepeatIndex > RepeatCount Then
  897.     
  898.     'set fill color
  899.     i = Rnd * 255: If i > 255 Then i = 255
  900.     j = Rnd * 255: If j > 255 Then j = 255
  901.     k = Rnd * 255: If k > 255 Then k = 255
  902.     FillColor = GetNearestColor(hDC, RGB(i, j, k))
  903.     
  904.     'set foreground color
  905.     i = Rnd * 255: If i > 255 Then i = 255
  906.     j = Rnd * 255: If j > 255 Then j = 255
  907.     k = Rnd * 255: If k > 255 Then k = 255
  908.     ForeColor = RGB(i, j, k)
  909.     
  910.     RepeatIndex = 1
  911.     Else
  912.     RepeatIndex = RepeatIndex + 1
  913.     End If
  914.  
  915.  
  916.     'Draw polygon
  917.     j = Polygon(hDC, Points(0), Sets)
  918.  
  919.     For j = 1 To Sets
  920.  
  921.         'determine new acceleration
  922.         ax1sa(j) = Rnd - .5
  923.         ay1sa(j) = Rnd - .5
  924.         
  925.         'calculate new position
  926.         Points(j).x = Points(j).x + vx1sa(j)
  927.         Points(j).y = Points(j).y + vy1sa(j)
  928.  
  929.         'calculate new velocity
  930.         vx1sa(j) = (vx1sa(j) + ax1sa(j)): If Abs(vx1sa(j)) > MaxSpeedX Then vx1sa(j) = 0: ax1sa(j) = 0
  931.         vy1sa(j) = (vy1sa(j) + ay1sa(j)): If Abs(vy1sa(j)) > MaxSpeedY Then vy1sa(j) = 0: ay1sa(j) = 0
  932.  
  933.         'check if off screen
  934.         If (Points(j).x > ScaleWidth) Then
  935.         'change direction
  936.         vx1sa(j) = -Abs(vx1sa(j))
  937.         ElseIf (Points(j).x < 0) Then
  938.         'change direction
  939.         vx1sa(j) = Abs(vx1sa(j))
  940.         End If
  941.  
  942.         If (Points(j).y > ScaleHeight) Then
  943.         'change direction
  944.         vy1sa(j) = -Abs(vy1sa(j))
  945.         ElseIf (Points(j).y < 0) Then
  946.         'change direction
  947.         vy1sa(j) = Abs(vy1sa(j))
  948.         End If
  949.  
  950.     Next j
  951.     
  952.     End If
  953.  
  954.  
  955. End Sub
  956.  
  957. Sub Form_KeyDown (KeyCode As Integer, Shift As Integer)
  958.     LogFile ("KeyPress, Terminating")
  959.     EndScrnsave                 ' End screen blanking
  960. End Sub
  961.  
  962. Sub Form_Load ()
  963.  
  964.     ' stretch to full screen
  965.     Move 0, 0, Screen.Width, Screen.Height
  966.     
  967.     'set system modal
  968.     If TestMode = 0 Then
  969.       i = SetSysModalWindow(hWND)
  970.     End If
  971.  
  972.     'make mouse invisible
  973.     If TestMode = 0 Then
  974.       HideMouse
  975.     End If
  976.  
  977.     'tell windows to disable screen savers
  978.     i = SystemParametersInfo(SPI_SETSCREENSAVEACTIVE, False, 0, 0)
  979.     
  980.     DrawWidth = 1
  981.  
  982.     Randomize
  983.  
  984.     ' Initialize variables now
  985.     MaxPlotType = 18
  986.     ReadPriorities ' call each Plot type to get its priority
  987.  
  988.     'set plot type
  989.     If StartSaver = 0 Then
  990.       PlotType = MaxPlotType * Rnd
  991.     Else
  992.       PlotType = StartSaver
  993.     End If
  994.  
  995.     If PlotType > MaxPlotType Then PlotType = 1
  996.  
  997.     LogFile ("First Saver is " + Str$(PlotType))
  998.  
  999.     PlotPriority = False
  1000.     PlotInit = False
  1001.     PlotEnd = False
  1002.  
  1003.     TimeInterval = 0
  1004.     MaxTime = MaxChangeMinutes * 60 + Timer ' calculate time in seconds
  1005.  
  1006.     'set tick rate
  1007.     Tick.Interval = 50
  1008.  
  1009.     Repeats = 1 ' number of drawings to make before returning
  1010.  
  1011.     Tick.Enabled = True
  1012.  
  1013. End Sub
  1014.  
  1015. Sub Form_MouseMove (Button As Integer, Shift As Integer, x As Single, y As Single)
  1016.     If IsEmpty(MouseX) Or IsEmpty(MouseY) Then
  1017.     MouseX = x
  1018.     MouseY = y
  1019.     LogFile ("First Mouse Movement (" + Str$(x) + "," + Str$(y) + ")")
  1020.     End If
  1021.  
  1022.     '
  1023.     ' Only unblank the screen if the mouse moves quickly
  1024.     ' enough (more than 2 pixels at one time.
  1025.     '
  1026.     If Abs(MouseX - x) > 2 Or Abs(MouseY - y) > 2 Then
  1027.        LogFile ("Mouse Movement (" + Str$(x) + "," + Str$(y) + "), Terminating")
  1028.        LogFile ("Old Pos (" + Str$(MouseX) + "," + Str$(MouseY) + "), Terminating")
  1029.        EndScrnsave             ' End screen blanking
  1030.     End If
  1031.     LogFile ("Mouse Movement (" + Str$(x) + "," + Str$(y) + "), Continuing")
  1032.     MouseX = x                   ' Remember last position
  1033.     MouseY = y
  1034. End Sub
  1035.  
  1036. Sub Form_Paint ()
  1037.     
  1038.     ' stretch to full screen
  1039.     Move 0, 0, Screen.Width, Screen.Height
  1040.  
  1041. End Sub
  1042.  
  1043. Function GetSize (FileName$) As Integer
  1044.     
  1045.     Dim InLine$
  1046.     Dim Loaded As Integer
  1047.  
  1048.     Open FileName$ For Binary As #1
  1049.  
  1050.     '*****************************************************
  1051.     'read header
  1052.     InLine$ = Input$(26, 1)
  1053.     
  1054.     If Asc(Mid$(InLine$, 1, 1)) <> &H42 Then GoTo errorexit
  1055.     If Asc(Mid$(InLine$, 2, 1)) <> &H4D Then GoTo errorexit
  1056.  
  1057.     PicWidth = Asc(Mid$(InLine$, 19, 1)) + Asc(Mid$(InLine$, 20, 1)) * 256
  1058.     PicHeight = Asc(Mid$(InLine$, 23, 1)) + Asc(Mid$(InLine$, 24, 1)) * 256
  1059.  
  1060.     'Debug.Print SWidth, SHeight
  1061.  
  1062.     Close #1
  1063.  
  1064.     Loaded = 1 'flag good read
  1065.  
  1066.     GoTo regexit
  1067.  
  1068. errorexit: Loaded = 0
  1069. regexit: ' no error exit
  1070.     GetSize = Loaded'return read state
  1071. End Function
  1072.  
  1073. Sub Kalied ()
  1074.   
  1075.   ' have a line and its mirror images trace across the
  1076.   ' screen with multiple previous copies following
  1077.   ' it
  1078.  
  1079.   Dim i As Integer, j As Integer, k As Integer, n As Integer
  1080.   Dim il As Long, jl As Long, kl As Long
  1081.   Dim xRadius As Integer, yRadius As Integer
  1082.   Dim HighMirror As Integer
  1083.   Dim xx1 As Integer, yy1 As Integer, xx2 As Integer, yy2 As Integer
  1084.   Dim xm1 As Integer, ym1 As Integer, xm2 As Integer, ym2 As Integer
  1085.  
  1086.   ' if first time then initialize
  1087.   If PlotInit = False Then
  1088.     
  1089.     'see if we need to reset changes made from previous init
  1090.     If PlotEnd = False Then
  1091.     
  1092.       'see if we just want the priority for this saver
  1093.       If PlotPriority = True Then
  1094.     '1 is normal priority, adjust up to show more often, or down ...
  1095.     Priority = 1#
  1096.     Exit Sub
  1097.       End If
  1098.     
  1099.     'check if runing low memory mode
  1100.     If CheckIfValidMode(0) = 0 Then
  1101.       Exit Sub
  1102.     End If
  1103.     
  1104.     PlotInit = True
  1105.     Cls
  1106.     ForeColor = QBColor(15)
  1107.  
  1108.     'select mirroring method
  1109.     HighMirror = 4
  1110.     Mirror = Rnd * HighMirror + 1: If Mirror > HighMirror Then Mirror = 1
  1111.  
  1112.     'Set array size and clear the elements
  1113.     ReDim x1a(MaxLines) As Integer
  1114.     ReDim x2a(MaxLines) As Integer
  1115.     ReDim y1a(MaxLines) As Integer
  1116.     ReDim y2a(MaxLines) As Integer
  1117.  
  1118.     Pointer = 1     ' start with array element 1
  1119.     
  1120.     ' set index to count number of times to repeat color
  1121.     '   to past maxvalue so that it will be recalculated
  1122.     RepeatIndex = MaxLines + 1
  1123.  
  1124.     'determine initial position of line
  1125.     x1 = Rnd * ScaleWidth
  1126.     x2 = Rnd * ScaleWidth
  1127.     y1 = Rnd * ScaleHeight
  1128.     y2 = Rnd * ScaleHeight
  1129.  
  1130.     'set initial velocity
  1131.     vx1 = 0
  1132.     vx2 = 0
  1133.     vy1 = 0
  1134.     vy2 = 0
  1135.  
  1136.     'set initial acceleration
  1137.     ax1 = 0
  1138.     ax2 = 0
  1139.     ay1 = 0
  1140.     ay2 = 0
  1141.     
  1142.     'find background color
  1143.     m = QBColor(0)
  1144.  
  1145.     'Calculate velocity limits
  1146.     MaxSpeedX = ScaleWidth * 15! / 800
  1147.     MaxSpeedY = ScaleWidth * 15! / 600
  1148.  
  1149.     'get conversion factors
  1150.     conv2x = 1# * ScaleWidth / ScaleHeight
  1151.     conv2y = 1# / conv2x
  1152.  
  1153.     'set tick rate
  1154.     Tick.Interval = 50
  1155.  
  1156.  
  1157.   Else 'reset changes done by previous init
  1158.  
  1159.     'reset tick rate
  1160.     Tick.Interval = 50
  1161.  
  1162.     'zero array sizes
  1163.     ReDim x1a(0) As Integer
  1164.     ReDim x2a(0) As Integer
  1165.     ReDim y1a(0) As Integer
  1166.     ReDim y2a(0) As Integer
  1167.  
  1168.   End If
  1169.  
  1170.   Else  ' put run code here
  1171.  
  1172.  
  1173.     ' check if time to get a new color
  1174.     If RepeatIndex > RepeatCount Then
  1175.     
  1176.     ' use rgb function
  1177.     Do
  1178.       il = Rnd * 255: If il > 255 Then il = 255
  1179.       jl = Rnd * 255: If jl > 255 Then jl = 255
  1180.       kl = Rnd * 255: If kl > 255 Then kl = 255
  1181.     Loop Until (il * il + jl * jl + kl * kl) > MinColor'make sure color if sufficiently bright
  1182.     l = RGB(il, jl, kl)
  1183.  
  1184.     RepeatIndex = 1
  1185.     Else
  1186.     RepeatIndex = RepeatIndex + 1
  1187.     End If
  1188.  
  1189.     'Delete original Lines
  1190.     xx1 = x1a(Pointer): yy1 = y1a(Pointer)
  1191.     xx2 = x2a(Pointer): yy2 = y2a(Pointer)
  1192.     Select Case Mirror
  1193.     Case 1: 'mirror on x and y axis
  1194.         Line (xx1, yy1)-(xx2, yy2), m
  1195.         Line (ScaleWidth - xx1, yy1)-(ScaleWidth - xx2, yy2), m
  1196.         Line (xx1, ScaleHeight - yy1)-(xx2, ScaleHeight - yy2), m
  1197.         Line (ScaleWidth - xx1, ScaleHeight - yy1)-(ScaleWidth - xx2, ScaleHeight - yy2), m
  1198.  
  1199.     Case 2: 'mirror on Y axis
  1200.         Line (xx1, yy1)-(xx2, yy2), m
  1201.         Line (ScaleWidth - xx1, yy1)-(ScaleWidth - xx2, yy2), m
  1202.  
  1203.     Case 3: 'mirror around center point
  1204.         Line (xx1, yy1)-(xx2, yy2), m
  1205.         Line (ScaleWidth - xx1, ScaleHeight - yy1)-(ScaleWidth - xx2, ScaleHeight - yy2), m
  1206.  
  1207.     Case 4: 'mirror on x and y axis and diagonally
  1208.         Line (xx1, yy1)-(xx2, yy2), m
  1209.         Line (ScaleWidth - xx1, yy1)-(ScaleWidth - xx2, yy2), m
  1210.         Line (xx1, ScaleHeight - yy1)-(xx2, ScaleHeight - yy2), m
  1211.         Line (ScaleWidth - xx1, ScaleHeight - yy1)-(ScaleWidth - xx2, ScaleHeight - yy2), m
  1212.  
  1213.         'mirror diagonally
  1214.         xm1 = yy1 * conv2x
  1215.         ym1 = xx1 * conv2y
  1216.         xm2 = yy2 * conv2x
  1217.         ym2 = xx2 * conv2y
  1218.         Line (xm1, ym1)-(xm2, ym2), m
  1219.         Line (ScaleWidth - xm1, ym1)-(ScaleWidth - xm2, ym2), m
  1220.         Line (xm1, ScaleHeight - ym1)-(xm2, ScaleHeight - ym2), m
  1221.         Line (ScaleWidth - xm1, ScaleHeight - ym1)-(ScaleWidth - xm2, ScaleHeight - ym2), m
  1222.  
  1223.  
  1224.     Case Else: Mirror = 1' if invalid value set, then change
  1225.     
  1226.     End Select
  1227.  
  1228.     'Save New Lines
  1229.     x1a(Pointer) = x1
  1230.     x2a(Pointer) = x2
  1231.     y1a(Pointer) = y1
  1232.     y2a(Pointer) = y2
  1233.  
  1234.     'Draw New Lines
  1235.     Select Case Mirror
  1236.     Case 1: 'mirror on x and y axis
  1237.         Line (x1, y1)-(x2, y2), l
  1238.         Line (ScaleWidth - x1, y1)-(ScaleWidth - x2, y2), l
  1239.         Line (x1, ScaleHeight - y1)-(x2, ScaleHeight - y2), l
  1240.         Line (ScaleWidth - x1, ScaleHeight - y1)-(ScaleWidth - x2, ScaleHeight - y2), l
  1241.  
  1242.     Case 2: 'mirror on Y axis
  1243.         Line (x1, y1)-(x2, y2), l
  1244.         Line (ScaleWidth - x1, y1)-(ScaleWidth - x2, y2), l
  1245.  
  1246.     Case 3: 'mirror around center point
  1247.         Line (x1, y1)-(x2, y2), l
  1248.         Line (ScaleWidth - x1, ScaleHeight - y1)-(ScaleWidth - x2, ScaleHeight - y2), l
  1249.  
  1250.     Case 4: 'mirror on x and y axis and diagonally
  1251.         Line (x1, y1)-(x2, y2), l
  1252.         Line (ScaleWidth - x1, y1)-(ScaleWidth - x2, y2), l
  1253.         Line (x1, ScaleHeight - y1)-(x2, ScaleHeight - y2), l
  1254.         Line (ScaleWidth - x1, ScaleHeight - y1)-(ScaleWidth - x2, ScaleHeight - y2), l
  1255.  
  1256.         'mirror diagonally
  1257.         xm1 = y1 * conv2x
  1258.         ym1 = x1 * conv2y
  1259.         xm2 = y2 * conv2x
  1260.         ym2 = x2 * conv2y
  1261.         Line (xm1, ym1)-(xm2, ym2), l
  1262.         Line (ScaleWidth - xm1, ym1)-(ScaleWidth - xm2, ym2), l
  1263.         Line (xm1, ScaleHeight - ym1)-(xm2, ScaleHeight - ym2), l
  1264.         Line (ScaleWidth - xm1, ScaleHeight - ym1)-(ScaleWidth - xm2, ScaleHeight - ym2), l
  1265.  
  1266.     Case Else: Mirror = 1' if invalid value set, then change
  1267.     
  1268.     End Select
  1269.  
  1270.     'Move pointer to next item
  1271.     Pointer = Pointer + 1
  1272.     If Pointer > MaxLines Then
  1273.         Pointer = 1
  1274.     End If
  1275.  
  1276.     'determine new acceleration
  1277.     ax1 = Rnd - .5
  1278.     ax2 = Rnd - .5
  1279.     ay1 = Rnd - .5
  1280.     ay2 = Rnd - .5
  1281.  
  1282.     'calculate new position
  1283.     x1 = x1 + vx1
  1284.     x2 = x2 + vx2
  1285.     y1 = y1 + vy1
  1286.     y2 = y2 + vy2
  1287.  
  1288.     'calculate new velocity
  1289.     vx1 = (vx1 + ax1): If Abs(vx1) > MaxSpeedX Then vx1 = 0: ax1 = 0
  1290.     vx2 = (vx2 + ax2): If Abs(vx2) > MaxSpeedX Then vx2 = 0: ax2 = 0
  1291.     vy1 = (vy1 + ay1): If Abs(vy1) > MaxSpeedY Then vy1 = 0: ay1 = 0
  1292.     vy2 = (vy2 + ay2): If Abs(vy2) > MaxSpeedY Then vy2 = 0: ay2 = 0
  1293.  
  1294.     'check if off screen
  1295.     If (x1 > ScaleWidth) Then
  1296.         'change direction
  1297.         vx1 = -Abs(vx1)
  1298.     ElseIf (x1 < 0) Then
  1299.         'change direction
  1300.         vx1 = Abs(vx1)
  1301.     End If
  1302.  
  1303.     If (y1 > ScaleHeight) Then
  1304.         'change direction
  1305.         vy1 = -Abs(vy1)
  1306.     ElseIf (y1 < 0) Then
  1307.         'change direction
  1308.         vy1 = Abs(vy1)
  1309.     End If
  1310.  
  1311.     If (x2 > ScaleWidth) Then
  1312.         'change direction
  1313.         vx2 = -Abs(vx2)
  1314.     ElseIf (x2 < 0) Then
  1315.         'change direction
  1316.         vx2 = Abs(vx2)
  1317.     End If
  1318.  
  1319.     If (y2 > ScaleHeight) Then
  1320.         'change direction
  1321.         vy2 = -Abs(vy2)
  1322.     ElseIf (y2 < 0) Then
  1323.         'change direction
  1324.         vy2 = Abs(vy2)
  1325.     End If
  1326.  
  1327.     
  1328.     End If
  1329.  
  1330. End Sub
  1331.  
  1332. Sub Kalied2 ()
  1333.   
  1334.   ' have a line and its mirror images trace across the
  1335.   ' screen with all the previous copies left on the screen
  1336.   ' until the maximum is reached and the screen cleared
  1337.  
  1338.   Dim i As Integer, j As Integer, k As Integer, n As Integer
  1339.   Dim il As Long, jl As Long, kl As Long
  1340.   Dim xRadius As Integer, yRadius As Integer
  1341.   Dim HighMirror As Integer
  1342.   Dim xm1 As Integer, ym1 As Integer, xm2 As Integer, ym2 As Integer
  1343.  
  1344.   ' if first time then initialize
  1345.   If PlotInit = False Then
  1346.     
  1347.     'see if we need to reset changes made from previous init
  1348.     If PlotEnd = True Then
  1349.       Exit Sub
  1350.     End If
  1351.     
  1352.       'see if we just want the priority for this saver
  1353.       If PlotPriority = True Then
  1354.     '1 is normal priority, adjust up to show more often, or down ...
  1355.     Priority = 1#
  1356.     Exit Sub
  1357.       End If
  1358.     
  1359.     'check if runing low memory mode
  1360.     If CheckIfValidMode(0) = 0 Then
  1361.       Exit Sub
  1362.     End If
  1363.     
  1364.     PlotInit = True
  1365.     Cls
  1366.     ForeColor = QBColor(15)
  1367.  
  1368.     'select mirroring method
  1369.     HighMirror = 4
  1370.     Mirror = Rnd * HighMirror + 1: If Mirror > HighMirror Then Mirror = 1
  1371.  
  1372.     Pointer = 1     ' set lines on screen to one
  1373.     
  1374.     ' set index to count number of times to repeat color
  1375.     '   to past maxvalue so that it will be recalculated
  1376.     RepeatIndex = MaxLines + 1
  1377.  
  1378.     'determine initial position of line
  1379.     x1 = Rnd * ScaleWidth
  1380.     x2 = Rnd * ScaleWidth
  1381.     y1 = Rnd * ScaleHeight
  1382.     y2 = Rnd * ScaleHeight
  1383.  
  1384.     'set initial velocity
  1385.     vx1 = 0
  1386.     vx2 = 0
  1387.     vy1 = 0
  1388.     vy2 = 0
  1389.  
  1390.     'set initial acceleration
  1391.     ax1 = 0
  1392.     ax2 = 0
  1393.     ay1 = 0
  1394.     ay2 = 0
  1395.     
  1396.     'find background color
  1397.     m = QBColor(0)
  1398.  
  1399.     'Calculate velocity limits
  1400.     MaxSpeedX = ScaleWidth * 15! / 800
  1401.     MaxSpeedY = ScaleWidth * 15! / 600
  1402.  
  1403.     'get conversion factors
  1404.     conv2x = 1# * ScaleWidth / ScaleHeight
  1405.     conv2y = 1# / conv2x
  1406.  
  1407.   Else  ' put run code here
  1408.  
  1409.  
  1410.     ' check if time to get a new color
  1411.     If RepeatIndex > RepeatCount Then
  1412.     
  1413.     ' use rgb function
  1414.     Do
  1415.       il = Rnd * 255: If il > 255 Then il = 255
  1416.       jl = Rnd * 255: If jl > 255 Then jl = 255
  1417.       kl = Rnd * 255: If kl > 255 Then kl = 255
  1418.     Loop Until (il * il + jl * jl + kl * kl) > MinColor'make sure color if sufficiently bright
  1419.     l = RGB(il, jl, kl)
  1420.  
  1421.     RepeatIndex = 1
  1422.     Else
  1423.     RepeatIndex = RepeatIndex + 1
  1424.     End If
  1425.  
  1426.     'Draw New Lines
  1427.     Select Case Mirror
  1428.     Case 1: 'mirror on x and y axis
  1429.         Line (x1, y1)-(x2, y2), l
  1430.         Line (ScaleWidth - x1, y1)-(ScaleWidth - x2, y2), l
  1431.         Line (x1, ScaleHeight - y1)-(x2, ScaleHeight - y2), l
  1432.         Line (ScaleWidth - x1, ScaleHeight - y1)-(ScaleWidth - x2, ScaleHeight - y2), l
  1433.  
  1434.     Case 2: 'mirror on Y axis
  1435.         Line (x1, y1)-(x2, y2), l
  1436.         Line (ScaleWidth - x1, y1)-(ScaleWidth - x2, y2), l
  1437.  
  1438.     Case 3: 'mirror around center point
  1439.         Line (x1, y1)-(x2, y2), l
  1440.         Line (ScaleWidth - x1, ScaleHeight - y1)-(ScaleWidth - x2, ScaleHeight - y2), l
  1441.     
  1442.     Case 4: 'mirror on x and y axis and diagonally
  1443.         Line (x1, y1)-(x2, y2), l
  1444.         Line (ScaleWidth - x1, y1)-(ScaleWidth - x2, y2), l
  1445.         Line (x1, ScaleHeight - y1)-(x2, ScaleHeight - y2), l
  1446.         Line (ScaleWidth - x1, ScaleHeight - y1)-(ScaleWidth - x2, ScaleHeight - y2), l
  1447.  
  1448.         'mirror diagonally
  1449.         xm1 = y1 * conv2x
  1450.         ym1 = x1 * conv2y
  1451.         xm2 = y2 * conv2x
  1452.         ym2 = x2 * conv2y
  1453.         Line (xm1, ym1)-(xm2, ym2), l
  1454.         Line (ScaleWidth - xm1, ym1)-(ScaleWidth - xm2, ym2), l
  1455.         Line (xm1, ScaleHeight - ym1)-(xm2, ScaleHeight - ym2), l
  1456.         Line (ScaleWidth - xm1, ScaleHeight - ym1)-(ScaleWidth - xm2, ScaleHeight - ym2), l
  1457.  
  1458.     Case Else: Mirror = 1' if invalid value set, then change
  1459.     
  1460.     End Select
  1461.  
  1462.     ' count total lines on screen
  1463.     Pointer = Pointer + 1
  1464.     If Pointer > MaxCums Then
  1465.         'when maximum reached then clear
  1466.         Cls
  1467.         Pointer = 1
  1468.     End If
  1469.  
  1470.     'determine new acceleration
  1471.     ax1 = Rnd - .5
  1472.     ax2 = Rnd - .5
  1473.     ay1 = Rnd - .5
  1474.     ay2 = Rnd - .5
  1475.  
  1476.     'calculate new position
  1477.     x1 = x1 + vx1
  1478.     x2 = x2 + vx2
  1479.     y1 = y1 + vy1
  1480.     y2 = y2 + vy2
  1481.  
  1482.     'calculate new velocity
  1483.     vx1 = (vx1 + ax1): If Abs(vx1) > MaxSpeedX Then vx1 = 0: ax1 = 0
  1484.     vx2 = (vx2 + ax2): If Abs(vx2) > MaxSpeedX Then vx2 = 0: ax2 = 0
  1485.     vy1 = (vy1 + ay1): If Abs(vy1) > MaxSpeedY Then vy1 = 0: ay1 = 0
  1486.     vy2 = (vy2 + ay2): If Abs(vy2) > MaxSpeedY Then vy2 = 0: ay2 = 0
  1487.  
  1488.     'check if off screen
  1489.     If (x1 > ScaleWidth) Then
  1490.         'change direction
  1491.         vx1 = -Abs(vx1)
  1492.     ElseIf (x1 < 0) Then
  1493.         'change direction
  1494.         vx1 = Abs(vx1)
  1495.     End If
  1496.  
  1497.     If (y1 > ScaleHeight) Then
  1498.         'change direction
  1499.         vy1 = -Abs(vy1)
  1500.     ElseIf (y1 < 0) Then
  1501.         'change direction
  1502.         vy1 = Abs(vy1)
  1503.     End If
  1504.  
  1505.     If (x2 > ScaleWidth) Then
  1506.         'change direction
  1507.         vx2 = -Abs(vx2)
  1508.     ElseIf (x2 < 0) Then
  1509.         'change direction
  1510.         vx2 = Abs(vx2)
  1511.     End If
  1512.  
  1513.     If (y2 > ScaleHeight) Then
  1514.         'change direction
  1515.         vy2 = -Abs(vy2)
  1516.     ElseIf (y2 < 0) Then
  1517.         'change direction
  1518.         vy2 = Abs(vy2)
  1519.     End If
  1520.  
  1521.     
  1522.     End If
  1523.  
  1524.  
  1525. End Sub
  1526.  
  1527. Sub Lines ()
  1528.  
  1529.   ' have a random number of lines trace across the
  1530.   ' screen with multiple previous copies following
  1531.   ' them
  1532.  
  1533.   Dim i As Integer, j As Integer, k As Integer, ii As Integer, n As Integer
  1534.   Dim il As Long, jl As Long, kl As Long
  1535.   Static Sets As Integer
  1536.   
  1537.   ' if first time then initialize
  1538.   If PlotInit = False Then
  1539.     
  1540.     'see if we need to reset changes made from previous init
  1541.     If PlotEnd = False Then
  1542.     
  1543.       'see if we just want the priority for this saver
  1544.       If PlotPriority = True Then
  1545.     '1 is normal priority, adjust up to show more often, or down ...
  1546.     Priority = 1#
  1547.     Exit Sub
  1548.       End If
  1549.     
  1550.     'check if runing low memory mode
  1551.     If CheckIfValidMode(0) = 0 Then
  1552.       Exit Sub
  1553.     End If
  1554.     
  1555.     PlotInit = True
  1556.     Cls
  1557.     ForeColor = QBColor(15)
  1558.  
  1559.     'set number of sets between 1 and 4
  1560.     Sets = Rnd * 3 + 1
  1561.  
  1562.     'Set array size and clear the elements
  1563.     ReDim x1da(MaxLines, Sets) As Integer
  1564.     ReDim x2da(MaxLines, Sets) As Integer
  1565.     ReDim y1da(MaxLines, Sets) As Integer
  1566.     ReDim y2da(MaxLines, Sets) As Integer
  1567.     ReDim x1sa(Sets) As Single
  1568.     ReDim x2sa(Sets) As Single
  1569.     ReDim y1sa(Sets) As Single
  1570.     ReDim y2sa(Sets) As Single
  1571.     ReDim vx1sa(Sets) As Single
  1572.     ReDim vx2sa(Sets) As Single
  1573.     ReDim vy1sa(Sets) As Single
  1574.     ReDim vy2sa(Sets) As Single
  1575.     ReDim ax1sa(Sets) As Single
  1576.     ReDim ax2sa(Sets) As Single
  1577.     ReDim ay1sa(Sets) As Single
  1578.     ReDim ay2sa(Sets) As Single
  1579.     ReDim Colors(Sets) As Long
  1580.     
  1581.     Pointer = 1     ' start with array element 1
  1582.     
  1583.     ' set index to count number of times to repeat color
  1584.     '   to past maxvalue so that it will be recalculated
  1585.     RepeatIndex = MaxLines + 1
  1586.  
  1587.     For j = 1 To Sets
  1588.  
  1589.     'determine initial position of line
  1590.     x1sa(j) = Rnd * ScaleWidth
  1591.     x2sa(j) = Rnd * ScaleWidth
  1592.     y1sa(j) = Rnd * ScaleHeight
  1593.     y2sa(j) = Rnd * ScaleHeight
  1594.  
  1595.     Next j
  1596.     
  1597.     'find background color
  1598.     m = QBColor(0)
  1599.  
  1600.     'Calculate velocity limits
  1601.     MaxSpeedX = ScaleWidth * 15! / 800
  1602.     MaxSpeedY = ScaleWidth * 15! / 600
  1603.  
  1604.  
  1605.   Else 'reset changes done by previous init
  1606.  
  1607.     'Set array size and clear the elements
  1608.     ReDim x1da(0, 0) As Integer
  1609.     ReDim x2da(0, 0) As Integer
  1610.     ReDim y1da(0, 0) As Integer
  1611.     ReDim y2da(0, 0) As Integer
  1612.     ReDim x1sa(0) As Single
  1613.     ReDim x2sa(0) As Single
  1614.     ReDim y1sa(0) As Single
  1615.     ReDim y2sa(0) As Single
  1616.     ReDim vx1sa(0) As Single
  1617.     ReDim vx2sa(0) As Single
  1618.     ReDim vy1sa(0) As Single
  1619.     ReDim vy2sa(0) As Single
  1620.     ReDim ax1sa(0) As Single
  1621.     ReDim ax2sa(0) As Single
  1622.     ReDim ay1sa(0) As Single
  1623.     ReDim ay2sa(0) As Single
  1624.     ReDim Colors(0) As Long
  1625.     
  1626.   End If
  1627.  
  1628.   Else  ' put run code here
  1629.  
  1630.  
  1631.     ' check if time to get a new color
  1632.     If RepeatIndex > RepeatCount Then
  1633.     
  1634.     ' use rgb function
  1635.     For ii = 1 To Sets
  1636.       Do
  1637.         il = Rnd * 255: If il > 255 Then il = 255
  1638.         jl = Rnd * 255: If jl > 255 Then jl = 255
  1639.         kl = Rnd * 255: If kl > 255 Then kl = 255
  1640.       Loop Until (il * il + jl * jl + kl * kl) > MinColor'make sure color if sufficiently bright
  1641.       Colors(ii) = RGB(il, jl, kl)
  1642.     Next ii
  1643.  
  1644.     RepeatIndex = 1
  1645.     Else
  1646.     RepeatIndex = RepeatIndex + 1
  1647.     End If
  1648.  
  1649.     'Delete original Lines
  1650.     For j = 1 To Sets
  1651.         Line (x1da(Pointer, j), y1da(Pointer, j))-(x2da(Pointer, j), y2da(Pointer, j)), m
  1652.     Next j
  1653.  
  1654.     For j = 1 To Sets
  1655.  
  1656.         'Save New Lines
  1657.         x1da(Pointer, j) = x1sa(j)
  1658.         x2da(Pointer, j) = x2sa(j)
  1659.         y1da(Pointer, j) = y1sa(j)
  1660.         y2da(Pointer, j) = y2sa(j)
  1661.  
  1662.         'Draw new Line
  1663.         Line (x1da(Pointer, j), y1da(Pointer, j))-(x2da(Pointer, j), y2da(Pointer, j)), Colors(j)
  1664.  
  1665.     Next j
  1666.  
  1667.     'Move pointer to next item
  1668.     Pointer = Pointer + 1
  1669.     If Pointer > MaxLines Then
  1670.         Pointer = 1
  1671.     End If
  1672.  
  1673.     For j = 1 To Sets
  1674.  
  1675.         'determine new acceleration
  1676.         ax1sa(j) = Rnd - .5
  1677.         ax2sa(j) = Rnd - .5
  1678.         ay1sa(j) = Rnd - .5
  1679.         ay2sa(j) = Rnd - .5
  1680.  
  1681.         'calculate new position
  1682.         x1sa(j) = x1sa(j) + vx1sa(j)
  1683.         x2sa(j) = x2sa(j) + vx2sa(j)
  1684.         y1sa(j) = y1sa(j) + vy1sa(j)
  1685.         y2sa(j) = y2sa(j) + vy2sa(j)
  1686.  
  1687.         'calculate new velocity
  1688.         vx1sa(j) = (vx1sa(j) + ax1sa(j)): If Abs(vx1sa(j)) > MaxSpeedX Then vx1sa(j) = 0: ax1sa(j) = 0
  1689.         vx2sa(j) = (vx2sa(j) + ax2sa(j)): If Abs(vx2sa(j)) > MaxSpeedX Then vx2sa(j) = 0: ax2sa(j) = 0
  1690.         vy1sa(j) = (vy1sa(j) + ay1sa(j)): If Abs(vy1sa(j)) > MaxSpeedY Then vy1sa(j) = 0: ay1sa(j) = 0
  1691.         vy2sa(j) = (vy2sa(j) + ay2sa(j)): If Abs(vy2sa(j)) > MaxSpeedY Then vy2sa(j) = 0: ay2sa(j) = 0
  1692.  
  1693.         'check if off screen
  1694.         If (x1sa(j) > ScaleWidth) Then
  1695.         'change direction
  1696.         vx1sa(j) = -Abs(vx1sa(j))
  1697.         ElseIf (x1sa(j) < 0) Then
  1698.         'change direction
  1699.         vx1sa(j) = Abs(vx1sa(j))
  1700.         End If
  1701.  
  1702.         If (y1sa(j) > ScaleHeight) Then
  1703.         'change direction
  1704.         vy1sa(j) = -Abs(vy1sa(j))
  1705.         ElseIf (y1sa(j) < 0) Then
  1706.         'change direction
  1707.         vy1sa(j) = Abs(vy1sa(j))
  1708.         End If
  1709.  
  1710.         If (x2sa(j) > ScaleWidth) Then
  1711.         'change direction
  1712.         vx2sa(j) = -Abs(vx2sa(j))
  1713.         ElseIf (x2sa(j) < 0) Then
  1714.         'change direction
  1715.         vx2sa(j) = Abs(vx2sa(j))
  1716.         End If
  1717.  
  1718.         If (y2sa(j) > ScaleHeight) Then
  1719.         'change direction
  1720.         vy2sa(j) = -Abs(vy2sa(j))
  1721.         ElseIf (y2sa(j) < 0) Then
  1722.         'change direction
  1723.         vy2sa(j) = Abs(vy2sa(j))
  1724.         End If
  1725.  
  1726.     Next j
  1727.     
  1728.     
  1729.   End If
  1730.  
  1731. End Sub
  1732.  
  1733. Sub MultiSpiros ()
  1734.  
  1735.   'Do spirograph like figures
  1736.  
  1737.   'reserve memory
  1738.   Const Deg2Pi = PI / 180
  1739.   Static MaxRad As Integer'maximum radius for circles
  1740.   Const MaxNodes = 35'maximum number of nodes on spiro
  1741.   Dim Nodes As Integer
  1742.   Const MaxRpts = 7'max times to go around circle
  1743.   Dim Rpts As Integer
  1744.   Const PlotPoints = 4'number of points to plot each time
  1745.   Const ClearCount = 3'number on screen before clearing
  1746.   Static PlotAngleIncr As Single
  1747.   Static PlotEndAngle As Single
  1748.   Static PlotAngle As Single
  1749.   Static SinIncr As Single
  1750.   Static SinAngle As Single
  1751.   Static Xcenter As Integer
  1752.   Static Ycenter As Integer
  1753.   Static Xincr As Integer
  1754.   Static Yincr As Integer
  1755.   Const MaxSpiro = 8' maximum number of simultaneous spiros
  1756.   Static SpiroCnt As Integer
  1757.   Static Rad1 As Integer
  1758.   Static Rad2 As Integer
  1759.   Dim R As Single
  1760.   Dim i As Integer, j As Integer, k As Integer, l As Integer, m As Integer, n As Integer
  1761.   Dim il As Long, jl As Long, kl As Long
  1762.  
  1763.   ' if first time then initialize
  1764.   If PlotInit = False Then
  1765.     
  1766.     'see if we need to reset changes made from previous init
  1767.     If PlotEnd = False Then
  1768.     
  1769.       'see if we just want the priority for this saver
  1770.       If PlotPriority = True Then
  1771.     '1 is normal priority, adjust up to show more often, or down ...
  1772.     Priority = 1#
  1773.     Exit Sub
  1774.       End If
  1775.     
  1776.     'check if runing low memory mode
  1777.     If CheckIfValidMode(0) = 0 Then
  1778.       Exit Sub
  1779.     End If
  1780.     
  1781.       PlotInit = True
  1782.       ForeColor = RGB(255, 255, 255)
  1783.       BackColor = RGB(0, 0, 0)
  1784.       Cls
  1785.  
  1786.      'initialize variables used
  1787.      PlotEndAngle = 0
  1788.      PlotAngle = 10
  1789.      MaxRad = ScaleHeight / 3'maximum radius for circles
  1790.      Pointer = 0
  1791.  
  1792.     Else 'reset changes done by previous init
  1793.  
  1794.       DrawWidth = 1' use narrow line
  1795.     
  1796.     End If
  1797.  
  1798.   Else  ' put run code here
  1799.  
  1800.  
  1801.     ' check if time to do new spiro
  1802.     If PlotAngle > PlotEndAngle Then
  1803.     
  1804.     'set foreground color
  1805.     Do
  1806.       il = Rnd * 255: If il > 255 Then il = 255
  1807.       jl = Rnd * 255: If jl > 255 Then jl = 255
  1808.       kl = Rnd * 255: If kl > 255 Then kl = 255
  1809.     Loop Until (il * il + jl * jl + kl * kl) > MinColor'make sure color if sufficiently bright
  1810.     ForeColor = RGB(il, jl, kl)
  1811.  
  1812.     PlotAngle = Rnd * 180 * Deg2Pi'initial offset
  1813.     Rpts = Rnd * MaxRpts + .5
  1814.     PlotAngleIncr = .125 * Rpts * Deg2Pi
  1815.     PlotEndAngle = 360 * Rpts * Deg2Pi + PlotAngle + PlotAngleIncr
  1816.     Nodes = Rnd * MaxNodes + .5
  1817.     SinIncr = PlotAngleIncr * Nodes / Rpts
  1818.     SinAngle = 0
  1819.     Rad1 = MaxRad * Rnd
  1820.     Rad2 = MaxRad * Rnd
  1821.  
  1822.     'get location of first
  1823.     Xcenter = Rnd * ScaleWidth * 3 / 4 + ScaleWidth / 8
  1824.     Ycenter = Rnd * ScaleHeight * 3 / 4 + ScaleHeight / 8
  1825.  
  1826.     'get location of last
  1827.     i = Rnd * ScaleWidth * 3 / 4 + ScaleWidth / 8
  1828.     j = Rnd * ScaleHeight * 3 / 4 + ScaleHeight / 8
  1829.  
  1830.     'get number
  1831.     SpiroCnt = (MaxSpiro - 2) * Rnd + 2' maximum number of simultaneous spiros
  1832.  
  1833.     'calculate increment
  1834.     Xincr = (i - Xcenter) / (SpiroCnt - 1)
  1835.     Yincr = (j - Ycenter) / (SpiroCnt - 1)
  1836.  
  1837.     DrawWidth = 1 + 2 * Rnd ' set line width
  1838.  
  1839.     GoSub 3000 'calculate x1 and y1
  1840.  
  1841.     Cls
  1842.     
  1843.     End If
  1844.  
  1845.     For i = 1 To PlotPoints
  1846.  
  1847.       GoSub 3000 'calculate x1 and y1
  1848.  
  1849.       k = x1: l = y1: m = LastX: n = LastY
  1850.  
  1851.       'plot each spiro
  1852.       For j = 1 To SpiroCnt
  1853.  
  1854.     'draw line
  1855.     Line (m, n)-(k, l)
  1856.  
  1857.     'get location for next
  1858.     k = k + Xincr: l = l + Yincr
  1859.     m = m + Xincr: n = n + Yincr
  1860.  
  1861.       Next j
  1862.  
  1863.     Next i
  1864.     
  1865.   End If
  1866.  
  1867.   Exit Sub
  1868.  
  1869. 3000 'calculate new point on screen
  1870.   LastX = x1: LastY = y1
  1871.   R = Rad1 + Rad2 * Sin(SinAngle)
  1872.   x1 = R * Cos(PlotAngle) + Xcenter
  1873.   y1 = R * Sin(PlotAngle) + Ycenter
  1874.   SinAngle = SinAngle + SinIncr
  1875.   PlotAngle = PlotAngle + PlotAngleIncr
  1876.  
  1877.   Return
  1878.  
  1879.  
  1880. End Sub
  1881.  
  1882. Sub NextSelection ()
  1883.  
  1884. Dim i As Integer
  1885. Dim Level As Single
  1886.  
  1887. If RandomFlag <> 0 Then
  1888.   ' pick a new selection but not the same as the last
  1889.   Do
  1890.     'i = Int(Rnd * MaxPlotType) + 1'choose next one at random
  1891.     Level = Rnd * TotalPriority' get random proportion of TP
  1892.  
  1893.     'now search array to see which saver this prop. falls into
  1894.     i = 1
  1895.     While (PriorityBreakPoints(i) <= Level)
  1896.       i = i + 1
  1897.     Wend
  1898.     'Debug.Print i, Level, TotalPriority
  1899.  
  1900.     If (i > MaxPlotType) Or (i < 1) Then i = PlotType'flag to try again
  1901.   Loop While (i = PlotType)
  1902.   PlotType = i
  1903.     
  1904. Else
  1905.   PlotType = PlotType + 1
  1906. End If
  1907.  
  1908. LogFile ("Next Saver is " + Str$(PlotType))
  1909.  
  1910. End Sub
  1911.  
  1912. Function NumberOfColors () As Single
  1913.  
  1914.   Dim i As Integer, j As Integer, k As Integer
  1915.  
  1916.   ' get bits per pixel per plane
  1917.   i = GetDeviceCaps(hDC, BITSPIXEL)
  1918.   ' get number of planes
  1919.   j = GetDeviceCaps(hDC, PLANES)
  1920.   ' get total bits per pixel
  1921.   k = i * j
  1922.   NumberOfColors = 2# ^ k
  1923. End Function
  1924.  
  1925. Sub Patch ()
  1926.  
  1927.   ' copy blocks of original screen to random spots
  1928.  
  1929.   ' if first time then initialize
  1930.   If PlotInit = False Then
  1931.     
  1932.     'see if we need to reset changes made from previous init
  1933.     If PlotEnd = False Then
  1934.     
  1935.       'see if we just want the priority for this saver
  1936.       If PlotPriority = True Then
  1937.     '1 is normal priority, adjust up to show more often, or down ...
  1938.     Priority = 1#
  1939.     Exit Sub
  1940.       End If
  1941.     
  1942.     'check if runing low memory mode
  1943.     If CheckIfValidMode(1) = 0 Then
  1944.       Exit Sub
  1945.     End If
  1946.     
  1947.     ' set tick rate down
  1948.     Tick.Interval = 250
  1949.  
  1950.     ' start with original screen
  1951.     Picture = Original.Image
  1952.     
  1953.     PlotInit = True
  1954.  
  1955.     i = Int(Rnd * 2#) 'if i=0 then alternate reverse copy
  1956.  
  1957.   Else 'reset changes done by previous init
  1958.  
  1959.     Picture = LoadPicture() ' clear screen
  1960.     
  1961.     'reset tick rate
  1962.     Tick.Interval = 50
  1963.  
  1964.   End If
  1965.  
  1966.   Else  ' put run code here
  1967.  
  1968.     BoxHeight = Rnd * ScaleHeight / 2.5
  1969.     Boxwidth = Rnd * ScaleWidth / 2.5 * (8# / 6#)
  1970.  
  1971.     ' get random locations
  1972.     x1 = Rnd * ScaleWidth
  1973.     y1 = Rnd * ScaleHeight
  1974.     x2 = Rnd * ScaleWidth
  1975.     y2 = Rnd * ScaleHeight
  1976.  
  1977.     'make sure room in destination and source blocks
  1978.     If x1 + Boxwidth > ScaleWidth Then Boxwidth = ScaleWidth - x1
  1979.     If x2 + Boxwidth > ScaleWidth Then Boxwidth = ScaleWidth - x2
  1980.     If y1 + BoxHeight > ScaleHeight Then BoxHeight = ScaleHeight - y1
  1981.     If y2 + BoxHeight > ScaleHeight Then BoxHeight = ScaleHeight - y2
  1982.  
  1983.     'BitBlt Box from x2,y2 to x1,y1
  1984.     DC = Original.hDC
  1985.     If i = 0 And Rnd < .5 Then
  1986.     BitBlt hDC, x1, y1, Boxwidth, BoxHeight, DC, x2, y2, &H330008 'not source copy
  1987.     Else
  1988.     BitBlt hDC, x1, y1, Boxwidth, BoxHeight, DC, x2, y2, &HCC0020 'source copy
  1989.     End If
  1990.     
  1991.   End If
  1992.  
  1993. End Sub
  1994.  
  1995. Sub Polygons ()
  1996.  
  1997.   ' draw a randomly moving polygon on the screen
  1998.   ' with multiple previous copies following it
  1999.  
  2000.   Dim i As Integer, j As Integer, k As Integer, ii As Integer, n As Integer
  2001.   Dim il As Long, jl As Long, kl As Long
  2002.   Static Sets As Integer
  2003.   
  2004.   ' if first time then initialize
  2005.   If PlotInit = False Then
  2006.     
  2007.     'see if we need to reset changes made from previous init
  2008.     If PlotEnd = False Then
  2009.     
  2010.       'see if we just want the priority for this saver
  2011.       If PlotPriority = True Then
  2012.     '1 is normal priority, adjust up to show more often, or down ...
  2013.     Priority = 1#
  2014.     Exit Sub
  2015.       End If
  2016.     
  2017.     'check if runing low memory mode
  2018.     If CheckIfValidMode(0) = 0 Then
  2019.       Exit Sub
  2020.     End If
  2021.     
  2022.     PlotInit = True
  2023.     Cls
  2024.     ForeColor = QBColor(15)
  2025.  
  2026.     'set number of sets between 3 and 5
  2027.     Sets = Rnd * 2 + 3
  2028.  
  2029.     'Set array size and clear the elements
  2030.     ReDim x1da(MaxLines, Sets) As Integer
  2031.     ReDim y1da(MaxLines, Sets) As Integer
  2032.     ReDim x1sa(Sets) As Single
  2033.     ReDim y1sa(Sets) As Single
  2034.     ReDim vx1sa(Sets) As Single
  2035.     ReDim vy1sa(Sets) As Single
  2036.     ReDim ax1sa(Sets) As Single
  2037.     ReDim ay1sa(Sets) As Single
  2038.     
  2039.     Pointer = 1     ' start with array element 1
  2040.     
  2041.     ' set index to count number of times to repeat color
  2042.     '   to past maxvalue so that it will be recalculated
  2043.     RepeatIndex = MaxLines + 1
  2044.  
  2045.     For j = 1 To Sets
  2046.  
  2047.     'determine initial position of line
  2048.     x1sa(j) = Rnd * ScaleWidth
  2049.     y1sa(j) = Rnd * ScaleHeight
  2050.  
  2051.     Next j
  2052.     
  2053.     'find background color
  2054.     m = QBColor(0)
  2055.  
  2056.     'Calculate velocity limits
  2057.     MaxSpeedX = ScaleWidth * 15! / 800
  2058.     MaxSpeedY = ScaleWidth * 15! / 600
  2059.  
  2060.  
  2061.   Else 'reset changes done by previous init
  2062.  
  2063.     'Set array size and clear the elements
  2064.     ReDim x1da(0, 0) As Integer
  2065.     ReDim y1da(0, 0) As Integer
  2066.     ReDim x1sa(0) As Single
  2067.     ReDim y1sa(0) As Single
  2068.     ReDim vx1sa(0) As Single
  2069.     ReDim vy1sa(0) As Single
  2070.     ReDim ax1sa(0) As Single
  2071.     ReDim ay1sa(0) As Single
  2072.     
  2073.   End If
  2074.  
  2075.   Else  ' put run code here
  2076.  
  2077.  
  2078.     ' check if time to get a new color
  2079.     If RepeatIndex > RepeatCount Then
  2080.     
  2081.     Do
  2082.       il = Rnd * 255: If il > 255 Then il = 255
  2083.       jl = Rnd * 255: If jl > 255 Then jl = 255
  2084.       kl = Rnd * 255: If kl > 255 Then kl = 255
  2085.     Loop Until (il * il + jl * jl + kl * kl) > MinColor'make sure color if sufficiently bright
  2086.     l = RGB(il, jl, kl)
  2087.     
  2088.     RepeatIndex = 1
  2089.     Else
  2090.     RepeatIndex = RepeatIndex + 1
  2091.     End If
  2092.  
  2093.     'Delete original Lines
  2094.     Line (x1da(Pointer, 1), y1da(Pointer, 1))-(x1da(Pointer, 2), y1da(Pointer, 2)), m
  2095.     For j = 3 To Sets
  2096.         Line -(x1da(Pointer, j), y1da(Pointer, j)), m
  2097.     Next j
  2098.     Line -(x1da(Pointer, 1), y1da(Pointer, 1)), m
  2099.  
  2100.     For j = 1 To Sets
  2101.  
  2102.         'Save New Lines
  2103.         x1da(Pointer, j) = x1sa(j)
  2104.         y1da(Pointer, j) = y1sa(j)
  2105.  
  2106.     Next j
  2107.  
  2108.     'Draw New Lines
  2109.     Line (x1da(Pointer, 1), y1da(Pointer, 1))-(x1da(Pointer, 2), y1da(Pointer, 2)), l
  2110.     For j = 3 To Sets
  2111.         Line -(x1da(Pointer, j), y1da(Pointer, j)), l
  2112.     Next j
  2113.     Line -(x1da(Pointer, 1), y1da(Pointer, 1)), l
  2114.  
  2115.  
  2116.     'Move pointer to next item
  2117.     Pointer = Pointer + 1
  2118.     If Pointer > MaxLines Then
  2119.         Pointer = 1
  2120.     End If
  2121.  
  2122.     For j = 1 To Sets
  2123.  
  2124.         'determine new acceleration
  2125.         ax1sa(j) = Rnd - .5
  2126.         ay1sa(j) = Rnd - .5
  2127.         
  2128.         'calculate new position
  2129.         x1sa(j) = x1sa(j) + vx1sa(j)
  2130.         y1sa(j) = y1sa(j) + vy1sa(j)
  2131.  
  2132.         'calculate new velocity
  2133.         vx1sa(j) = (vx1sa(j) + ax1sa(j)): If Abs(vx1sa(j)) > MaxSpeedX Then vx1sa(j) = 0: ax1sa(j) = 0
  2134.         vy1sa(j) = (vy1sa(j) + ay1sa(j)): If Abs(vy1sa(j)) > MaxSpeedY Then vy1sa(j) = 0: ay1sa(j) = 0
  2135.  
  2136.         'check if off screen
  2137.         If (x1sa(j) > ScaleWidth) Then
  2138.         'change direction
  2139.         vx1sa(j) = -Abs(vx1sa(j))
  2140.         ElseIf (x1sa(j) < 0) Then
  2141.         'change direction
  2142.         vx1sa(j) = Abs(vx1sa(j))
  2143.         End If
  2144.  
  2145.         If (y1sa(j) > ScaleHeight) Then
  2146.         'change direction
  2147.         vy1sa(j) = -Abs(vy1sa(j))
  2148.         ElseIf (y1sa(j) < 0) Then
  2149.         'change direction
  2150.         vy1sa(j) = Abs(vy1sa(j))
  2151.         End If
  2152.  
  2153.     Next j
  2154.     
  2155.     End If
  2156.  
  2157. End Sub
  2158.  
  2159. Sub Puzzle ()
  2160.  
  2161.   'scramble screen by shifting one column or row at a time
  2162.   
  2163.   Dim tempx As Integer, tempy As Integer
  2164.   Dim x As Integer, y As Integer
  2165.  
  2166.   ' if first time then initialize
  2167.   If PlotInit = False Then
  2168.     
  2169.     'see if we need to reset changes made from previous init
  2170.     If PlotEnd = False Then
  2171.     
  2172.       'see if we just want the priority for this saver
  2173.       If PlotPriority = True Then
  2174.     '1 is normal priority, adjust up to show more often, or down ...
  2175.     Priority = 1#
  2176.     Exit Sub
  2177.       End If
  2178.     
  2179.     'check if runing low memory mode
  2180.     If CheckIfValidMode(1) = 0 Then
  2181.       Exit Sub
  2182.     End If
  2183.     
  2184.     ' set tick rate down
  2185.     Tick.Interval = 1000
  2186.  
  2187.     ' start with original screen
  2188.     Picture = Original.Image
  2189.     
  2190.     'find background color
  2191.     m = QBColor(0)
  2192.  
  2193.     PlotInit = True
  2194.  
  2195.     Number = Rnd * 16 + 4
  2196.     'Number = 20
  2197.  
  2198.     BoxHeight = ScaleHeight / Number
  2199.     Boxwidth = ScaleWidth / Number
  2200.  
  2201.     'initialize blocks
  2202.     ReDim x1da(Number, Number) As Integer
  2203.     ReDim y1da(Number, Number) As Integer
  2204.     For x1 = 1 To Number
  2205.     For y1 = 1 To Number
  2206.         x1da(x1, y1) = (x1 - 1) * Boxwidth
  2207.         y1da(x1, y1) = (y1 - 1) * BoxHeight
  2208.     Next y1
  2209.     Next x1
  2210.  
  2211.   Else 'reset changes done by previous init
  2212.  
  2213.     ReDim x1da(0, 0) As Integer
  2214.     ReDim y1da(0, 0) As Integer
  2215.  
  2216.     'reset tick rate
  2217.     Tick.Interval = 50
  2218.  
  2219.     Picture = LoadPicture() ' clear screen
  2220.  
  2221.   End If
  2222.  
  2223.   Else  ' put run code here
  2224.  
  2225.     If Int(Rnd * 2) = 1 Then 'shift column
  2226.     x1 = Rnd * Number + 1: If x1 > Number Then x1 = 1
  2227.     If Int(Rnd * 2) = 1 Then 'shift down
  2228.         tempx = x1da(x1, Number)
  2229.         tempy = y1da(x1, Number)
  2230.         For y1 = Number To 2 Step -1
  2231.         x1da(x1, y1) = x1da(x1, y1 - 1)
  2232.         y1da(x1, y1) = y1da(x1, y1 - 1)
  2233.  
  2234.         'BitBlt Box to x1,y1
  2235.         DC = Original.hDC
  2236.         x = (x1 - 1) * Boxwidth
  2237.         y = (y1 - 1) * BoxHeight
  2238.         BitBlt hDC, x, y, Boxwidth, BoxHeight, DC, x1da(x1, y1), y1da(x1, y1), &HCC0020
  2239.         Line (x, y)-Step(Boxwidth, BoxHeight), m, B
  2240.         Next y1
  2241.         y1 = 1
  2242.         x1da(x1, y1) = tempx
  2243.         y1da(x1, y1) = tempy
  2244.  
  2245.         'BitBlt Box to x1,y1
  2246.         DC = Original.hDC
  2247.         x = (x1 - 1) * Boxwidth
  2248.         y = (y1 - 1) * BoxHeight
  2249.         BitBlt hDC, x, y, Boxwidth, BoxHeight, DC, x1da(x1, y1), y1da(x1, y1), &HCC0020
  2250.         Line (x, y)-Step(Boxwidth, BoxHeight), m, B
  2251.  
  2252.     Else ' shift up
  2253.  
  2254.         tempx = x1da(x1, 1)
  2255.         tempy = y1da(x1, 1)
  2256.         For y1 = 1 To (Number - 1)
  2257.         x1da(x1, y1) = x1da(x1, y1 + 1)
  2258.         y1da(x1, y1) = y1da(x1, y1 + 1)
  2259.  
  2260.         'BitBlt Box to x1,y1
  2261.         DC = Original.hDC
  2262.         x = (x1 - 1) * Boxwidth
  2263.         y = (y1 - 1) * BoxHeight
  2264.         BitBlt hDC, x, y, Boxwidth, BoxHeight, DC, x1da(x1, y1), y1da(x1, y1), &HCC0020
  2265.         Line (x, y)-Step(Boxwidth, BoxHeight), m, B
  2266.         
  2267.         Next y1
  2268.         y1 = Number
  2269.         x1da(x1, y1) = tempx
  2270.         y1da(x1, y1) = tempy
  2271.  
  2272.         'BitBlt Box to x1,y1
  2273.         DC = Original.hDC
  2274.         x = (x1 - 1) * Boxwidth
  2275.         y = (y1 - 1) * BoxHeight
  2276.         BitBlt hDC, x, y, Boxwidth, BoxHeight, DC, x1da(x1, y1), y1da(x1, y1), &HCC0020
  2277.         Line (x, y)-Step(Boxwidth, BoxHeight), m, B
  2278.  
  2279.     End If
  2280.  
  2281.     Else ' shift row
  2282.     
  2283.     y1 = Rnd * Number + 1: If y1 > Number Then y1 = 1
  2284.     If Int(Rnd * 2) = 1 Then 'shift right
  2285.         tempx = x1da(Number, y1)
  2286.         tempy = y1da(Number, y1)
  2287.         For x1 = Number To 2 Step -1
  2288.         x1da(x1, y1) = x1da(x1 - 1, y1)
  2289.         y1da(x1, y1) = y1da(x1 - 1, y1)
  2290.  
  2291.         'BitBlt Box to x1,y1
  2292.         DC = Original.hDC
  2293.         x = (x1 - 1) * Boxwidth
  2294.         y = (y1 - 1) * BoxHeight
  2295.         BitBlt hDC, x, y, Boxwidth, BoxHeight, DC, x1da(x1, y1), y1da(x1, y1), &HCC0020
  2296.         Line (x, y)-Step(Boxwidth, BoxHeight), m, B
  2297.  
  2298.         Next x1
  2299.         x1 = 1
  2300.         x1da(x1, y1) = tempx
  2301.         y1da(x1, y1) = tempy
  2302.         
  2303.         'BitBlt Box to x1,y1
  2304.         DC = Original.hDC
  2305.         x = (x1 - 1) * Boxwidth
  2306.         y = (y1 - 1) * BoxHeight
  2307.         BitBlt hDC, x, y, Boxwidth, BoxHeight, DC, x1da(x1, y1), y1da(x1, y1), &HCC0020
  2308.         Line (x, y)-Step(Boxwidth, BoxHeight), m, B
  2309.  
  2310.     Else 'shift left
  2311.  
  2312.         tempx = x1da(1, y1)
  2313.         tempy = y1da(1, y1)
  2314.         For x1 = 1 To (Number - 1)
  2315.         x1da(x1, y1) = x1da(x1 + 1, y1)
  2316.         y1da(x1, y1) = y1da(x1 + 1, y1)
  2317.  
  2318.         'BitBlt Box to x1,y1
  2319.         DC = Original.hDC
  2320.         x = (x1 - 1) * Boxwidth
  2321.         y = (y1 - 1) * BoxHeight
  2322.         BitBlt hDC, x, y, Boxwidth, BoxHeight, DC, x1da(x1, y1), y1da(x1, y1), &HCC0020
  2323.         Line (x, y)-Step(Boxwidth, BoxHeight), m, B
  2324.  
  2325.         Next x1
  2326.         x1 = Number
  2327.         x1da(x1, y1) = tempx
  2328.         y1da(x1, y1) = tempy
  2329.         
  2330.         'BitBlt Box to x1,y1
  2331.         DC = Original.hDC
  2332.         x = (x1 - 1) * Boxwidth
  2333.         y = (y1 - 1) * BoxHeight
  2334.         BitBlt hDC, x, y, Boxwidth, BoxHeight, DC, x1da(x1, y1), y1da(x1, y1), &HCC0020
  2335.         Line (x, y)-Step(Boxwidth, BoxHeight), m, B
  2336.  
  2337.     End If
  2338.  
  2339.     End If
  2340.  
  2341.   End If
  2342.  
  2343.  
  2344. End Sub
  2345.  
  2346. Sub ReadPriorities ()
  2347.     
  2348.     Dim i As Integer
  2349.     ReDim PriorityBreakPoints(MaxPlotType + 1) As Single
  2350.     TotalPriority = 0
  2351.  
  2352.     'flad that we want to read priorities
  2353.     PlotPriority = True: PlotInit = False: PlotEnd = False
  2354.  
  2355.     For i = 1 To MaxPlotType
  2356.       Priority = 1#'default priority level
  2357.       PlotType = i: RunSelection' get priority for saver
  2358.       If Priority < 0# Then Priority = 0#
  2359.       TotalPriority = TotalPriority + Priority
  2360.       PriorityBreakPoints(i) = TotalPriority
  2361.     Next
  2362.  
  2363.     PriorityBreakPoints(MaxPlotType + 1) = TotalPriority + 3.402E+38
  2364.  
  2365. End Sub
  2366.  
  2367. Sub Replicate (FileName$)
  2368.  
  2369.   Dim x As Integer, y As Integer, x1 As Integer, y1 As Integer
  2370.  
  2371.   DoEvents
  2372.   DoEvents
  2373.  
  2374.   If GetSize(FileName$) = 0 Then Exit Sub
  2375.  
  2376.   DC = CreateDC("DISPLAY", 0&, 0&, 0&)
  2377.  
  2378.   'limit sizes
  2379.   If PicWidth > ScrnWidth Then PicWidth = ScrnWidth
  2380.   If PicHeight > ScrnHeight Then PicHeight = ScrnHeight
  2381.  
  2382.   If (PicWidth < ScrnWidth) Or (PicHeight < ScrnHeight) Then
  2383.  
  2384.     'need to center picture
  2385.  
  2386.     'first backup picture
  2387.     BitBlt Original.hDC, 0, 0, PicWidth, PicHeight, DC, 0, 0, &HCC0020
  2388.  
  2389.     'clear original
  2390.     Picture = LoadPicture()
  2391.  
  2392.     ' now copy back centered
  2393.     x = ScrnWidth / 2 - PicWidth / 2
  2394.     y = ScrnHeight / 2 - PicHeight / 2
  2395.     BitBlt DC, x, y, PicWidth, PicHeight, Original.hDC, 0, 0, &HCC0020
  2396.  
  2397.  
  2398.   End If
  2399.  
  2400.   If (PicWidth < ScrnWidth) Then 'fill row
  2401.  
  2402.     '1st copy left
  2403.     x1 = x
  2404.     While x1 > 0
  2405.       BitBlt DC, x1 - PicWidth, 0, PicWidth, ScrnHeight, DC, x, 0, &HCC0020
  2406.       x1 = x1 - PicWidth
  2407.     Wend
  2408.   
  2409.     'next copy right
  2410.     x1 = x
  2411.     While x1 < ScrnWidth
  2412.       BitBlt DC, x1 + PicWidth, 0, PicWidth, ScrnHeight, DC, x, 0, &HCC0020
  2413.       x1 = x1 + PicWidth
  2414.     Wend
  2415.  
  2416.   End If
  2417.   
  2418.   If (PicHeight < ScrnHeight) Then
  2419.  
  2420.     '1st copy up
  2421.     y1 = y
  2422.     While y1 > 0
  2423.       BitBlt DC, 0, y1 - PicHeight, ScrnWidth, PicHeight, DC, 0, y, &HCC0020
  2424.       y1 = y1 - PicHeight
  2425.     Wend
  2426.   
  2427.     'next copy down
  2428.     y1 = y
  2429.     While y1 < ScrnHeight
  2430.       BitBlt DC, 0, y1 + PicHeight, ScrnWidth, PicHeight, DC, 0, y, &HCC0020
  2431.       y1 = y1 + PicHeight
  2432.     Wend
  2433.  
  2434.   End If
  2435.  
  2436.   DeleteDC DC
  2437.  
  2438. End Sub
  2439.  
  2440. Sub Roll ()
  2441.  
  2442.   ' the display rolls both horizontally and vertically
  2443.  
  2444.   Dim v As Integer
  2445.  
  2446.   ' if first time then initialize
  2447.   If PlotInit = False Then
  2448.     
  2449.     'see if we need to reset changes made from previous init
  2450.     If PlotEnd = False Then
  2451.     
  2452.       'see if we just want the priority for this saver
  2453.       If PlotPriority = True Then
  2454.     '1 is normal priority, adjust up to show more often, or down ...
  2455.     Priority = 1#
  2456.     Exit Sub
  2457.       End If
  2458.     
  2459.     'check if runing low memory mode
  2460.     If CheckIfValidMode(1) = 0 Then
  2461.       Exit Sub
  2462.     End If
  2463.     
  2464.     ' start with original screen
  2465.     Picture = Original.Image
  2466.  
  2467.     PlotInit = True
  2468.  
  2469.     'Calculate velocity limits
  2470.     MaxSpeedX = ScaleWidth * 15! / 800
  2471.     MaxSpeedY = ScaleWidth * 15! / 600
  2472.  
  2473.     ' initial velocities
  2474.     vy1 = 0: vx1 = 0
  2475.  
  2476.     ' initial offset
  2477.     x1 = 0: y1 = 0
  2478.  
  2479.     Direction = Rnd * 2: If Direction > 1 Then Direction = 0
  2480.  
  2481.   Else 'reset changes done by previous init
  2482.  
  2483.     Picture = LoadPicture() ' clear screen
  2484.  
  2485.   End If
  2486.  
  2487.   Else  ' put run code here
  2488.  
  2489.     DC = Original.hDC
  2490.  
  2491.     If Direction Then
  2492.     ' do vertical scroll
  2493.     BitBlt hDC, 0, y1, ScaleWidth, ScaleHeight - y1, DC, 0, 0, &HCC0020
  2494.     BitBlt hDC, 0, 0, ScaleWidth, y1, DC, 0, ScaleHeight - y1, &HCC0020
  2495.     Else
  2496.     ' do horizontal scroll
  2497.     BitBlt hDC, x1, 0, ScaleWidth - x1, ScaleHeight, DC, 0, 0, &HCC0020
  2498.     BitBlt hDC, 0, 0, x1, ScaleHeight, DC, ScaleWidth - x1, 0, &HCC0020
  2499.     End If
  2500.  
  2501.     'determine new acceleration
  2502.     ax1 = Rnd - .5
  2503.     ay1 = Rnd - .5
  2504.         
  2505.     'calculate new velocity
  2506.     vx1 = (vx1 + ax1): If Abs(vx1) > MaxSpeedX Then vx1 = 0: ax1 = 0
  2507.     vy1 = (vy1 + ay1): If Abs(vy1) > MaxSpeedY Then vy1 = 0: ay1 = 0
  2508.  
  2509.     'find new roll amount
  2510.     x1 = x1 + vx1
  2511.     If x1 > ScaleWidth Then
  2512.     x1 = x1 - ScaleWidth
  2513.     Else
  2514.     If x1 < 0 Then
  2515.         x1 = x1 + ScaleWidth
  2516.     End If
  2517.     End If
  2518.         
  2519.     y1 = y1 + vy1
  2520.     If y1 > ScaleHeight Then
  2521.     y1 = y1 - ScaleHeight
  2522.     Else
  2523.     If y1 < 0 Then
  2524.         y1 = y1 + ScaleHeight
  2525.     End If
  2526.     End If
  2527.         
  2528.   End If
  2529.  
  2530. End Sub
  2531.  
  2532. Sub RunSelection ()
  2533.  
  2534.     ' execute the appropriate selection
  2535.  
  2536.     Select Case PlotType
  2537.  
  2538.     Case 1: Squiggles
  2539.     Case 2: Kalied2
  2540.     Case 3: Polygons
  2541.     Case 4: Circles
  2542.     Case 5: Kalied
  2543.     Case 6: Lines
  2544.     Case 7: Roll
  2545.     Case 8: FilledCircles
  2546.     Case 9: Patch
  2547.     Case 10: Spiro
  2548.     Case 11: Scrape
  2549.     Case 12: Stretch
  2550.     Case 13: Dribble
  2551.     Case 14: Drop
  2552.     Case 15: Slides
  2553.     Case 16: FilledPolygons
  2554.     Case 17: MultiSpiros
  2555.     Case 18: Puzzle
  2556.     Case Else: PlotType = 1
  2557.            RunSelection ' try again
  2558.  
  2559.     End Select
  2560.  
  2561. End Sub
  2562.  
  2563. Sub Scrape ()
  2564.  
  2565.   ' bitblt's with various patterns, dragging them
  2566.   ' across the screen randomly
  2567.  
  2568.   ' if first time then initialize
  2569.   If PlotInit = False Then
  2570.     
  2571.     'see if we need to reset changes made from previous init
  2572.     If PlotEnd = False Then
  2573.     
  2574.       'see if we just want the priority for this saver
  2575.       If PlotPriority = True Then
  2576.     '1 is normal priority, adjust up to show more often, or down ...
  2577.     Priority = 1#
  2578.     Exit Sub
  2579.       End If
  2580.     
  2581.     'check if runing low memory mode
  2582.     If CheckIfValidMode(1) = 0 Then
  2583.       Exit Sub
  2584.     End If
  2585.     
  2586.     ' start with original screen
  2587.     Picture = Original.Image
  2588.     
  2589.     PlotInit = True
  2590.  
  2591.     'determine initial position of line
  2592.     x1 = Rnd * ScaleWidth
  2593.     y1 = Rnd * ScaleHeight
  2594.     
  2595.     'Calculate velocity limits
  2596.     MaxSpeedX = ScaleWidth * 15! / 800
  2597.     MaxSpeedY = ScaleWidth * 15! / 600
  2598.  
  2599.     BoxHeight = 400 * Rnd ^ 3 + 20
  2600.     Boxwidth = (400 * Rnd ^ 3 + 20) * (8# / 6#)
  2601.  
  2602.     ' zero initial velocity
  2603.     vx1 = 0: vy1 = 0
  2604.  
  2605.     ' choose scrape type at random
  2606.     i = Rnd * 11
  2607.     Select Case i
  2608.  
  2609.     Case 0: Pattern = &H42 'Black Out
  2610.         Locked = True
  2611.     Case 1: Pattern = &HFF0062 'White Out
  2612.         Locked = True
  2613.     Case 2: Pattern = &HBB0226 'MergePaint
  2614.         Locked = False
  2615.     Case 3: Pattern = &H330008 'Not source copy
  2616.         Locked = True
  2617.     Case 4: Pattern = &H330008 'Not source copy
  2618.         Locked = False
  2619.     Case 5: Pattern = &H660046 'source invert
  2620.         Locked = True
  2621.     Case 6: Pattern = &H8800C6 'source and
  2622.         Locked = False
  2623.     Case 7: Pattern = &HEE0086 'source paint (or)
  2624.         Locked = False
  2625.     Case 8: Pattern = &H550009 'Invert Destination
  2626.         Locked = True
  2627.     Case 9: Pattern = &HCC0020 'Source Copy
  2628.         Locked = False
  2629.     Case Else: Pattern = &HCC0020 'Source Copy
  2630.         Locked = True
  2631.         Picture = LoadPicture() ' start with blank screen
  2632.  
  2633.     End Select
  2634.     
  2635.   Else 'reset changes done by previous init
  2636.  
  2637.     Picture = LoadPicture() ' start with blank screen
  2638.  
  2639.   End If
  2640.  
  2641.   Else  ' put run code here
  2642.  
  2643.     ' do locking if necessary
  2644.     If Locked Then
  2645.         x2 = x1: y2 = y1
  2646.     Else 'do offset
  2647.         x2 = x1 + Boxwidth: If x2 + Boxwidth > ScaleWidth Then x2 = 0
  2648.         y2 = y1 + BoxHeight: If y2 + BoxHeight > ScaleHeight Then y2 = 0
  2649.     End If
  2650.  
  2651.     'BitBlt Box at x1,y1
  2652.     DC = Original.hDC
  2653.     BitBlt hDC, x1, y1, Boxwidth, BoxHeight, DC, x2, y2, Pattern
  2654.     
  2655.     'determine new acceleration
  2656.     ax1 = Rnd - .5
  2657.     ay1 = Rnd - .5
  2658.         
  2659.     'calculate new position
  2660.     x1 = x1 + vx1
  2661.     y1 = y1 + vy1
  2662.         
  2663.     'calculate new velocity
  2664.     vx1 = (vx1 + ax1): If Abs(vx1) > MaxSpeedX Then vx1 = 0: ax1 = 0
  2665.     vy1 = (vy1 + ay1): If Abs(vy1) > MaxSpeedY Then vy1 = 0: ay1 = 0
  2666.         
  2667.     'check if off screen
  2668.     If (x1 > ScaleWidth - Boxwidth) Then
  2669.         'change direction
  2670.         vx1 = -Abs(vx1)
  2671.     ElseIf (x1 < 0) Then
  2672.         'change direction
  2673.         vx1 = Abs(vx1)
  2674.     End If
  2675.  
  2676.     If (y1 > ScaleHeight - BoxHeight) Then
  2677.         'change direction
  2678.         vy1 = -Abs(vy1)
  2679.     ElseIf (y1 < 0) Then
  2680.         'change direction
  2681.         vy1 = Abs(vy1)
  2682.     End If
  2683.  
  2684.     
  2685.     
  2686.   End If
  2687.  
  2688.  
  2689. End Sub
  2690.  
  2691. Sub Slides ()
  2692.  
  2693.   'cycle between different bitmaps
  2694.  
  2695.   Dim j As Integer
  2696.   Static file As String
  2697.   Static OldTime As Long
  2698.   Static running As Integer
  2699.   Dim CurTime As Long
  2700.   Dim FileName As String
  2701.  
  2702.   ' if first time then initialize
  2703.   If PlotInit = False Then
  2704.     
  2705.     'see if we need to reset changes made from previous init
  2706.     If PlotEnd = False Then
  2707.     
  2708.       'see if we just want the priority for this saver
  2709.       If PlotPriority = True Then
  2710.     '1 is normal priority, adjust up to show more often, or down ...
  2711.     Priority = 1#
  2712.     Exit Sub
  2713.       End If
  2714.     
  2715.     'check if runing low memory mode
  2716.     If CheckIfValidMode(1) = 0 Then
  2717.       Exit Sub
  2718.     End If
  2719.     
  2720.     j = Rnd * 50
  2721.  
  2722.     FileName = BitmapsDir
  2723.     FileName = RTrim$(FileName)
  2724.     FileName = FileName + "\*.bmp"
  2725.     On Error GoTo 115
  2726.     file = Dir$(FileName)' get first file in directory
  2727.     On Error GoTo 0
  2728.  
  2729.     If file = "" Then
  2730.       NextSelection 'jump to next since there are no bitmap files in directory
  2731.       Exit Sub
  2732.     End If
  2733.  
  2734.     For i = 1 To j
  2735.  
  2736.       file = Dir$ ' get next file
  2737.  
  2738.       If file = "" Then
  2739.  
  2740.     FileName = BitmapsDir + "\*.bmp"
  2741.     file = Dir$(FileName)' get first file in directory
  2742.  
  2743.       End If
  2744.  
  2745.     Next i
  2746.  
  2747.     OldTime = Timer
  2748.  
  2749.     running = False
  2750.  
  2751.     On Error GoTo 116
  2752.     Picture = LoadPicture(BitmapsDir + "\" + file)
  2753.     On Error GoTo 0
  2754.  
  2755.  
  2756.     Replicate (BitmapsDir + "\" + file)
  2757.  
  2758.     PlotInit = True
  2759.  
  2760.  
  2761.   Else 'reset changes done by previous init
  2762.  
  2763.       ' save screen in place of original for latter use
  2764.       ' we do this because on palette based systems
  2765.       ' the slide procedure messes up the color
  2766.       ' palette and the Clipboard.setData 9 and
  2767.       ' Clipboard.GetData(9) sequence does not restore
  2768.       ' it, so we just use the new picture with the
  2769.       ' new palette from now on
  2770.       DC = CreateDC("DISPLAY", 0&, 0&, 0&)
  2771.       BitBlt Original.hDC, 0, 0, ScrnWidth, ScrnHeight, DC, 0, 0, &HCC0020
  2772.       DeleteDC DC
  2773.  
  2774.     Picture = LoadPicture() ' clear screen
  2775.  
  2776.   End If
  2777.  
  2778. Else  ' put run code here
  2779.  
  2780.     If running Then Exit Sub ' no recursive calls
  2781.  
  2782.     If file = "" Then Exit Sub
  2783.  
  2784.     CurTime = Timer
  2785.     If (CurTime >= OldTime) And ((OldTime + BmpSeconds) > CurTime) Then Exit Sub
  2786.  
  2787.     OldTime = Timer
  2788.  
  2789.     running = True
  2790.  
  2791.     j = Rnd * 20
  2792.  
  2793.     For i = 1 To j
  2794.  
  2795.       file = Dir$ ' get next file
  2796.  
  2797.       If file = "" Then
  2798.  
  2799.     FileName = BitmapsDir + "\*.bmp"
  2800.     file = Dir$(FileName)' get first file in directory
  2801.  
  2802.       End If
  2803.  
  2804.     Next i
  2805.  
  2806.     Picture = LoadPicture(BitmapsDir + "\" + file)
  2807.  
  2808.     Replicate (BitmapsDir + "\" + file)
  2809.  
  2810.   End If
  2811.  
  2812.   running = False
  2813.  
  2814.   Exit Sub
  2815.  
  2816. 115 'directory path does not exist
  2817.   On Error GoTo 0
  2818.   LogFile ("Could not find file " + FileName)
  2819.   Resume 117
  2820.  
  2821. 116 'directory path does not exist
  2822.   On Error GoTo 0
  2823.   LogFile ("Out of Memory.  Could not load file " + BitmapsDir + "\" + file)
  2824.   Resume 117
  2825.  
  2826. 117 NextSelection 'jump to next since there are no bitmap files in directory
  2827.   Exit Sub
  2828.  
  2829. End Sub
  2830.  
  2831. Sub Spiro ()
  2832.  
  2833.   'Do spirograph like figures
  2834.  
  2835.   'reserve memory
  2836.   Const Deg2Pi = PI / 180
  2837.   Static MaxRad As Integer'maximum radius for circles
  2838.   Const MaxNodes = 35'maximum number of nodes on spiro
  2839.   Dim Nodes As Integer
  2840.   Const MaxRpts = 7'max times to go around circle
  2841.   Dim Rpts As Integer
  2842.   Const PlotPoints = 4'number of points to plot each time
  2843.   Const ClearCount = 3'number on screen before clearing
  2844.   Static PlotAngleIncr As Single
  2845.   Static PlotEndAngle As Single
  2846.   Static PlotAngle As Single
  2847.   Static SinIncr As Single
  2848.   Static SinAngle As Single
  2849.   Static Xcenter As Integer
  2850.   Static Ycenter As Integer
  2851.   Static Rad1 As Integer
  2852.   Static Rad2 As Integer
  2853.   Dim R As Single
  2854.   Dim i As Long, j As Long, k As Long, l As Integer
  2855.  
  2856.   ' if first time then initialize
  2857.   If PlotInit = False Then
  2858.     
  2859.     'see if we need to reset changes made from previous init
  2860.     If PlotEnd = False Then
  2861.     
  2862.       'see if we just want the priority for this saver
  2863.       If PlotPriority = True Then
  2864.     '1 is normal priority, adjust up to show more often, or down ...
  2865.     Priority = 1#
  2866.     Exit Sub
  2867.       End If
  2868.     
  2869.     'check if runing low memory mode
  2870.     If CheckIfValidMode(0) = 0 Then
  2871.       Exit Sub
  2872.     End If
  2873.     
  2874.       PlotInit = True
  2875.       ForeColor = RGB(255, 255, 255)
  2876.       BackColor = RGB(0, 0, 0)
  2877.       Cls
  2878.  
  2879.      'initialize variables used
  2880.      PlotEndAngle = 0
  2881.      PlotAngle = 10
  2882.      MaxRad = ScaleHeight / 3'maximum radius for circles
  2883.      Pointer = 0
  2884.  
  2885.     Else 'reset changes done by previous init
  2886.  
  2887.       DrawWidth = 1' use narrow line
  2888.     
  2889.     End If
  2890.  
  2891.   Else  ' put run code here
  2892.  
  2893.  
  2894.     ' check if time to do new spiro
  2895.     If PlotAngle > PlotEndAngle Then
  2896.     
  2897.     'set foreground color
  2898.     Do
  2899.       i = Rnd * 255: If i > 255 Then i = 255
  2900.       j = Rnd * 255: If j > 255 Then j = 255
  2901.       k = Rnd * 255: If k > 255 Then k = 255
  2902.     Loop Until (i * i + j * j + k * k) > MinColor'make sure color if sufficiently bright
  2903.     ForeColor = RGB(i, j, k)
  2904.  
  2905.     PlotAngle = Rnd * 180 * Deg2Pi'initial offset
  2906.     Rpts = Rnd * MaxRpts + .5
  2907.     PlotAngleIncr = .125 * Rpts * Deg2Pi
  2908.     PlotEndAngle = 360 * Rpts * Deg2Pi + PlotAngle + PlotAngleIncr
  2909.     Nodes = Rnd * MaxNodes + .5
  2910.     SinIncr = PlotAngleIncr * Nodes / Rpts
  2911.     SinAngle = 0
  2912.     Rad1 = MaxRad * Rnd
  2913.     Rad2 = MaxRad * Rnd
  2914.     Xcenter = Rnd * ScaleWidth * 3 / 4 + ScaleWidth / 8
  2915.     Ycenter = Rnd * ScaleHeight * 3 / 4 + ScaleHeight / 8
  2916.  
  2917.     DrawWidth = 1 + 2 * Rnd' use narrow line
  2918.  
  2919.     GoSub 2000 'calculate x1 and y1
  2920.  
  2921.     Pointer = Pointer + 1
  2922.     If Pointer >= ClearCount Then
  2923.       Cls
  2924.       Pointer = 0
  2925.     End If
  2926.     
  2927.     End If
  2928.  
  2929.     For l = 1 To PlotPoints
  2930.  
  2931.       GoSub 2000 'calculate x1 and y1
  2932.     
  2933.       'draw line
  2934.       Line (LastX, LastY)-(x1, y1)
  2935.  
  2936.     Next l
  2937.     
  2938.   End If
  2939.  
  2940.   Exit Sub
  2941.  
  2942. 2000 'calculate new point on screen
  2943.   LastX = x1: LastY = y1
  2944.   R = Rad1 + Rad2 * Sin(SinAngle)
  2945.   x1 = R * Cos(PlotAngle) + Xcenter
  2946.   y1 = R * Sin(PlotAngle) + Ycenter
  2947.   SinAngle = SinAngle + SinIncr
  2948.   PlotAngle = PlotAngle + PlotAngleIncr
  2949.  
  2950.   Return
  2951.  
  2952. End Sub
  2953.  
  2954. Sub Squiggles ()
  2955.  
  2956.   ' draw multiple squiggles on the screen.
  2957.   ' each squiggle is assign a random color at the
  2958.   ' start, then the head travels randomly and the
  2959.   ' tail is erased
  2960.  
  2961.   Dim i As Integer, j As Integer, k As Integer, ii As Integer, n As Integer
  2962.   Dim il As Long, jl As Long, kl As Long
  2963.   Static SquigNumb As Integer
  2964.   Static SquigLen As Integer
  2965.   Static EndPointer As Integer, StartPointer As Integer
  2966.  
  2967.   ' if first time then initialize
  2968.   If PlotInit = False Then
  2969.     
  2970.     'see if we need to reset changes made from previous init
  2971.     If PlotEnd = False Then
  2972.     
  2973.       'see if we just want the priority for this saver
  2974.       If PlotPriority = True Then
  2975.     '1 is normal priority, adjust up to show more often, or down ...
  2976.     Priority = 1#
  2977.     Exit Sub
  2978.       End If
  2979.     
  2980.     'check if runing low memory mode
  2981.     If CheckIfValidMode(0) = 0 Then
  2982.       Exit Sub
  2983.     End If
  2984.     
  2985.     PlotInit = True
  2986.     Cls
  2987.     ForeColor = QBColor(15)
  2988.  
  2989.     SquigNumb = Rnd * 10 + 10
  2990.     SquigLen = Rnd * 100 + 50
  2991.  
  2992.     'Allocate Memory
  2993.     ReDim x1da(SquigLen, SquigNumb)  As Integer
  2994.     ReDim y1da(SquigLen, SquigNumb)  As Integer
  2995.     ReDim x1sa(SquigNumb) As Single
  2996.     ReDim y1sa(SquigNumb) As Single
  2997.     ReDim vx1sa(SquigNumb) As Single
  2998.     ReDim vy1sa(SquigNumb) As Single
  2999.     ReDim ax1sa(SquigNumb) As Single
  3000.     ReDim ay1sa(SquigNumb) As Single
  3001.     ReDim Colors(SquigNumb) As Long
  3002.     
  3003.     Pointer = 1
  3004.  
  3005.     'Print "Clearing Array"
  3006.     For j = 1 To SquigNumb
  3007.     'determine initial position of line
  3008.     x1sa(j) = Rnd * ScaleWidth
  3009.     y1sa(j) = Rnd * ScaleHeight
  3010.  
  3011.     For i = 1 To SquigLen
  3012.         x1da(i, j) = x1sa(j)
  3013.         y1da(i, j) = y1sa(j)
  3014.     Next i
  3015.  
  3016.     Next j
  3017.     
  3018.     'find background color
  3019.     m = QBColor(0)
  3020.  
  3021.     ' use rgb function to get colors
  3022.     For ii = 1 To SquigNumb
  3023.     Do
  3024.       il = Rnd * 255: If il > 255 Then il = 255
  3025.       jl = Rnd * 255: If jl > 255 Then jl = 255
  3026.       kl = Rnd * 255: If kl > 255 Then kl = 255
  3027.     Loop Until (il * il + jl * jl + kl * kl) > MinColor'make sure color if sufficiently bright
  3028.     Colors(ii) = RGB(il, jl, kl)
  3029.     Next ii
  3030.  
  3031.     'Calculate velocity limits
  3032.     MaxSpeedX = ScaleWidth * 15! / 800
  3033.     MaxSpeedY = ScaleWidth * 15! / 600
  3034.  
  3035.   Else 'reset changes done by previous init
  3036.  
  3037.     ReDim x1da(0, 0)  As Integer
  3038.     ReDim y1da(0, 0)  As Integer
  3039.     ReDim x1sa(0) As Single
  3040.     ReDim y1sa(0) As Single
  3041.     ReDim vx1sa(0) As Single
  3042.     ReDim vy1sa(0) As Single
  3043.     ReDim ax1sa(0) As Single
  3044.     ReDim ay1sa(0) As Single
  3045.     ReDim Colors(0) As Long
  3046.     
  3047.   End If
  3048.  
  3049.   Else  ' put run code here
  3050.   
  3051.  
  3052.     'find where tail line went to
  3053.     If Pointer < SquigLen Then
  3054.         EndPointer = Pointer + 1
  3055.     Else
  3056.         EndPointer = 1
  3057.     End If
  3058.  
  3059.     'find where new line goes
  3060.     If Pointer > 1 Then
  3061.         StartPointer = Pointer - 1
  3062.     Else
  3063.         StartPointer = SquigLen
  3064.     End If
  3065.  
  3066.     If Rnd < .1 Then 'change a color 10% of the time
  3067.     
  3068.       ii = Int(Rnd * SquigNumb + 1)' get random squiggle to change
  3069.       If ii > SquigNumb Then ii = 1
  3070.       Do
  3071.         il = Rnd * 255: If il > 255 Then il = 255
  3072.         jl = Rnd * 255: If jl > 255 Then jl = 255
  3073.         kl = Rnd * 255: If kl > 255 Then kl = 255
  3074.       Loop Until (il * il + jl * jl + kl * kl) > MinColor'make sure color if sufficiently bright
  3075.       Colors(ii) = RGB(il, jl, kl)
  3076.  
  3077.     End If
  3078.  
  3079.     For j = 1 To SquigNumb
  3080.     
  3081.         'Erase tails of squigles
  3082.         Line (x1da(Pointer, j), y1da(Pointer, j))-(x1da(EndPointer, j), y1da(EndPointer, j)), m
  3083.  
  3084.         'Save new points
  3085.         x1da(Pointer, j) = x1sa(j)
  3086.         y1da(Pointer, j) = y1sa(j)
  3087.  
  3088.         'Draw front of Squigles
  3089.         Line (x1da(StartPointer, j), y1da(StartPointer, j))-(x1da(Pointer, j), y1da(Pointer, j)), Colors(j)
  3090.  
  3091.     Next j
  3092.  
  3093.     'Move pointer to next item
  3094.     Pointer = Pointer + 1
  3095.     If Pointer > SquigLen Then
  3096.         Pointer = 1
  3097.     End If
  3098.  
  3099.     For j = 1 To SquigNumb
  3100.  
  3101.         'determine new acceleration
  3102.         ax1sa(j) = Rnd * 4 - 2
  3103.         ay1sa(j) = Rnd * 4 - 2
  3104.  
  3105.         'calculate new position
  3106.         x1sa(j) = x1sa(j) + vx1sa(j)
  3107.         y1sa(j) = y1sa(j) + vy1sa(j)
  3108.  
  3109.         'calculate new velocity
  3110.         vx1sa(j) = (vx1sa(j) + ax1sa(j)): If Abs(vx1sa(j)) > 20 Then vx1sa(j) = 0: ax1sa(j) = 0
  3111.         vy1sa(j) = (vy1sa(j) + ay1sa(j)): If Abs(vy1sa(j)) > 20 Then vy1sa(j) = 0: ay1sa(j) = 0
  3112.  
  3113.         'check if off screen
  3114.         If (x1sa(j) > ScaleWidth) Then
  3115.         x1sa(j) = ScaleWidth
  3116.         'change direction
  3117.         vx1sa(j) = -Abs(vx1sa(j))
  3118.         ElseIf (x1sa(j) < 0) Then
  3119.         x1sa(j) = 0
  3120.         'change direction
  3121.         vx1sa(j) = Abs(vx1sa(j))
  3122.         End If
  3123.  
  3124.         If (y1sa(j) > ScaleHeight) Then
  3125.         y1sa(j) = ScaleHeight
  3126.         'change direction
  3127.         vy1sa(j) = -Abs(vy1sa(j))
  3128.         ElseIf (y1sa(j) < 0) Then
  3129.         y1sa(j) = 0
  3130.         'change direction
  3131.         vy1sa(j) = Abs(vy1sa(j))
  3132.         End If
  3133.  
  3134.     Next j
  3135.     
  3136.   End If
  3137.  
  3138. End Sub
  3139.  
  3140. Sub Stretch ()
  3141.  
  3142.     Dim x As Integer, y As Integer
  3143.     Dim NumColors As Single
  3144.  
  3145.   ' does a StretchBlt from a random box within the Original
  3146.   ' image and then displays it on the screen
  3147.  
  3148.   ' if first time then initialize
  3149.   If PlotInit = False Then
  3150.     
  3151.     'see if we need to reset changes made from previous init
  3152.     If PlotEnd = False Then
  3153.     
  3154.       'see if we just want the priority for this saver
  3155.       If PlotPriority = True Then
  3156.     '1 is normal priority, adjust up to show more often, or down ...
  3157.     Priority = 1#
  3158.     Exit Sub
  3159.       End If
  3160.  
  3161.     'check if runing low memory mode
  3162.     If CheckIfValidMode(2) = 0 Then
  3163.       Exit Sub
  3164.     End If
  3165.     
  3166.     'see how many colors display can handle
  3167.     NumColors = NumberOfColors()
  3168.     If NumColors <= 256 Then 'see if palette based
  3169.       LogFile ("Saver does not work in palette display mode: " + Str$(PlotType))
  3170.       NextSelection 'jump to next since this does not work
  3171.             'well with palettes
  3172.       Exit Sub
  3173.     End If
  3174.     
  3175.     ' set tick rate down
  3176.     Tick.Interval = 300
  3177.  
  3178.     ' start with original screen
  3179.     Picture = Original.Image
  3180.  
  3181.     ' start temp form same as original
  3182.     DC = Original.hDC
  3183.     BitBlt hDC, 0, 0, ScaleWidth, ScaleHeight, DC, 0, 0, &HCC0020
  3184.     BitBlt Temp.hDC, 0, 0, ScaleWidth, ScaleHeight, hDC, 0, 0, &HCC0020
  3185.  
  3186.     PlotInit = True
  3187.  
  3188.     'initial position is 1:1 copy
  3189.     x1 = 0
  3190.     y1 = 0
  3191.     x2 = ScaleWidth
  3192.     y2 = ScaleHeight
  3193.     
  3194.     'Calculate velocity limits
  3195.     MaxSpeedX = ScaleWidth * 15! / 800
  3196.     MaxSpeedY = ScaleWidth * 15! / 600
  3197.  
  3198.     ' zero initial velocity
  3199.     vx1 = MaxSpeedX * Rnd
  3200.     vy1 = MaxSpeedY * Rnd
  3201.     vx2 = -MaxSpeedX * Rnd
  3202.     vy2 = -MaxSpeedY * Rnd
  3203.  
  3204.     Pattern = &HCC0020 'Source Copy
  3205.   
  3206.   Else 'reset changes done by previous init
  3207.  
  3208.     Picture = LoadPicture() ' clear screen
  3209.  
  3210.     'reset tick rate
  3211.     Tick.Interval = 50
  3212.  
  3213.   End If
  3214.  
  3215.   Else  ' put run code here
  3216.  
  3217.     'make sure x1,y1 less than x2,y2 or swap
  3218.     If x1 > x2 Then x = x1: x1 = x2: x2 = x
  3219.     If y1 > y2 Then y = y1: y1 = y2: y2 = y
  3220.  
  3221.     'make sure that source box size does not
  3222.     'go below a minimum
  3223.     If x2 - x1 < 40 Then x2 = x1 + 40
  3224.     If y2 - y1 < 40 Then y2 = y1 + 40
  3225.  
  3226.     'Stretch Box from x1,y1 to x2,y2 onto display
  3227.     DC = Original.hDC
  3228.     x = x2 - x1: y = y2 - y1
  3229.     i = StretchBlt(Temp.hDC, ByVal 0, ByVal 0, ScaleWidth, ScaleHeight, DC, x1, y1, x, y, &HCC0020)
  3230.     'i = StretchBlt(hDC, ByVal 0, ByVal 0, ScaleWidth, ScaleHeight, DC, x1, y1, x, y, &HCC0020)
  3231.  
  3232.     ' now that it has been stretched, write to display
  3233.     DC = Temp.hDC
  3234.     BitBlt hDC, 0, 0, ScaleWidth, ScaleHeight, DC, 0, 0, &HCC0020
  3235.     
  3236.     'determine new acceleration
  3237.     ax1 = Rnd - .5
  3238.     ay1 = Rnd - .5
  3239.     ax2 = Rnd - .5
  3240.     ay2 = Rnd - .5
  3241.         
  3242.     'calculate new position
  3243.     x1 = x1 + vx1
  3244.     y1 = y1 + vy1
  3245.     x2 = x2 + vx2
  3246.     y2 = y2 + vy2
  3247.  
  3248.     'calculate new velocity
  3249.     vx1 = (vx1 + ax1): If Abs(vx1) > MaxSpeedX Then vx1 = 0: ax1 = 0
  3250.     vy1 = (vy1 + ay1): If Abs(vy1) > MaxSpeedY Then vy1 = 0: ay1 = 0
  3251.     vx2 = (vx2 + ax2): If Abs(vx2) > MaxSpeedX Then vx2 = 0: ax2 = 0
  3252.     vy2 = (vy2 + ay2): If Abs(vy2) > MaxSpeedY Then vy2 = 0: ay2 = 0
  3253.  
  3254.     'check if off screen
  3255.     If (x1 >= ScaleWidth) Then
  3256.         'change direction
  3257.         vx1 = -Abs(vx1)
  3258.         x1 = ScaleWidth - 1
  3259.     ElseIf (x1 < 0) Then
  3260.         'change direction
  3261.         vx1 = Abs(vx1)
  3262.         x1 = 0
  3263.     End If
  3264.  
  3265.     If (y1 >= ScaleHeight) Then
  3266.         'change direction
  3267.         vy1 = -Abs(vy1)
  3268.         y1 = ScaleHeight - 1
  3269.     ElseIf (y1 < 0) Then
  3270.         'change direction
  3271.         vy1 = Abs(vy1)
  3272.         y1 = 0
  3273.     End If
  3274.  
  3275.     'check if off screen
  3276.     If (x2 >= ScaleWidth) Then
  3277.         'change direction
  3278.         vx2 = -Abs(vx2)
  3279.         x2 = ScaleWidth - 1
  3280.     ElseIf (x2 < 0) Then
  3281.         'change direction
  3282.         vx2 = Abs(vx2)
  3283.         x2 = 0
  3284.     End If
  3285.  
  3286.     If (y2 >= ScaleHeight) Then
  3287.         'change direction
  3288.         vy2 = -Abs(vy2)
  3289.         y2 = ScaleHeight - 1
  3290.     ElseIf (y2 < 0) Then
  3291.         'change direction
  3292.         vy2 = Abs(vy2)
  3293.         y2 = 0
  3294.     End If
  3295.  
  3296.     
  3297.   End If
  3298.  
  3299. End Sub
  3300.  
  3301. Sub Tick_Timer ()
  3302.  
  3303.     ' check elapsed time to see if need to change type of plot
  3304.     ' also check if past midnight
  3305.     CurrentTime = Timer
  3306.     If (CurrentTime > MaxTime) Or (LastTime > CurrentTime) Then
  3307.     MaxTime = MaxChangeMinutes * 60 + CurrentTime ' calculate time in seconds
  3308.  
  3309.     ' make sure form is still on top
  3310.     ZOrder 0
  3311.  
  3312.     'clear old saver
  3313.     PlotInit = False: PlotEnd = True
  3314.     PlotPriority = False
  3315.     LogFile ("Cleanup after " + Str$(PlotType))
  3316.     RunSelection 'just clean up after running
  3317.  
  3318.     'see if we want random selection
  3319.     NextSelection 'get new PlotType
  3320.  
  3321.     PlotInit = False: PlotEnd = False
  3322.  
  3323.     End If
  3324.     
  3325.     LastTime = CurrentTime
  3326.  
  3327.     RunSelection
  3328.  
  3329. End Sub
  3330.  
  3331.